home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / COMMUNIC / H191.ZIP / CA29-3.EXE / BBS.SRC < prev    next >
Text File  |  1993-07-14  |  82KB  |  2,589 lines
  1. ; ----- COM-AND Scripted BBS mode
  2. ;    Commenced: 03/18/88 R.McG
  3. ;    Updated:    2/--/89 R.McG
  4. ;           10/--/89 R.McG (Allow blank lines, preserve lines to disc)
  5. ;    Ver 1.1:   11/--/90 R.McG (Make BBSETUP utility script)
  6. ;    Ver 1.2:   11/--/91 R.McG (Correct 88 char record len in BBS-MAIL)
  7. ;            4/--/91 R.McG (Add editor to BBMAINT scripts)
  8. ;    Ver 1.3:    4/--/93 R.McG (Added SCHEDULER hook for one-call use)
  9. ;                  (Added drop-to-DOS doorway)
  10. ;                  (allow sysop to type user commands from kbd)
  11. ; -----------------------------------------------------------------------
  12. ;    Goals:
  13. ;    o    Must autodetect caller's baud rate
  14. ;    o    Must work correctly for modems reporting true CD and otherwise.
  15. ;
  16. ;    Functions:
  17. ;    o    ID/Passworded log-on (with registration)
  18. ;    o    Capabilities set by SYSOP
  19. ;    o    UP and DOWNLOADS
  20. ;    o    Mail and bulletins
  21. ;    o    Privileged access (Pathlist,CHDIR, DOS commands)
  22. ;    o    .. including drop-to-DOS using a doorway function
  23. ;    --------------------------------------------------------------
  24. ;    Data for this script are established through the BBSETUP script.
  25. ;    The drop-to-DOS requires a doorway function (such as DOORWAY,
  26. ;    by Marshsall Dudley), and the script HOSTART.  The only other
  27. ;    file requisite to this HOST script is the TREED p/d utility.
  28. ;    --------------------------------------------------------------
  29. ; -----------------------------------------------------------------------
  30. ;    Usages:
  31. ;      S0 ------> General scratch buffer
  32. ;      S1 ------> ID;password during logon; ID after logon upper cased
  33. ;      S2-S5 ---> scratch
  34. ;      S6 ------> Logon time (used by Read_Comm to timeout)
  35. ;      S7 ------> scratch
  36. ;      S8 ------> Scratch buffer
  37. ;      S9 ------> General read buffer
  38. ;      S10-S18 -> Scratch buffers
  39. ;      S19 -----> Is used to save default subdir within commands
  40. ;      S20-S25 -> Default values from BBSDAT
  41. ;             S20 -> port, speed
  42. ;             S21 -> modem init we'll use for restart
  43. ;             S22 -> BBS default subdir
  44. ;             S23 -> BBS default files subdir
  45. ;             S24 -> BBS default mail subdir
  46. ;             S25 -> BBS default bulletin subdir
  47. ;             S26 -> Doorway command (or null)
  48. ;      S27 -----> 1 char read buffer used by Read_comm
  49. ;      S28 -----> DLDIR on entry
  50. ;      S29 -----> subdirectory on entry
  51. ;
  52. ;      N0 ------> # minutes allowed for call (set by logon)
  53. ;      N10-N19 -> Generally scratch
  54. ;      N27-N30 -> Counters used by Read_Comm
  55. ;      N97-N99 -> Generally scratch
  56. ;
  57. ;      FLAG(0) -> ON if an error condition is being reported...
  58. ;          Upon return from Read_Comm: ON -> timeout or disconn
  59. ;          Upon return from Logon -> OFF -> Logon OK
  60. ;      FLAG(1) -> After Logon, privileged access if ON
  61. ;      FLAG(2) -> a CHDIR has been performed by a privileged user
  62. ;      FLAG(3) -> There is a logged on caller (if true)
  63. ; -----------------------------------------------------------------------
  64. ;
  65.     LEGEND "Scripted BBS (1.3); initializing"
  66.     WOPEN 10,1  12,78 (default)
  67.     ATSAY 11,3 (default) "Initializing BBS.. "
  68. ;
  69. ;    Set default values (in case BBSDAT does not exist)
  70. ;
  71.     S20 = "_PARM"(11:14)*","*"_PARM"(0:3) ; Port(4),speed(4)
  72.     S21 = "ATE0Q0V1X1S0=2 S7=30 S9=10^M"  ; Standard MINIT for BBS
  73.     S22 = "\BBS"                    ; Set to our subdirectory
  74.     S23 = "\BBS\FILES"              ; Set subdir for files
  75.     S24 = "\BBS\MAIL"               ; Set subdir for mail
  76.     S25 = "\BBS\BULLETIN"           ; Set subdir for bulletins
  77.     S26 = ""                        ; Doorway command init empty
  78. ;
  79. ;    Initialize COM related values (This is done here to allow BBSDAT
  80. ;    ... edits to override these settings)
  81. ;
  82.     SET PARITY NONE         ; BBS is fixed no parity
  83.     SET DATA 8            ; BBS is fixed 8 data bits
  84.     SET STOP 1            ; bbs is fixed 1 stop bit
  85.     SET MASK ON            ; accept 7 or 8 bits
  86.     SET CR_IN CR_LF         ; Display received c/rs as a cr/lf
  87.     SET ASCII UP_LF LF        ; Send LFs
  88.     SET SOFTFLOW ON         ; Allow XON/XOFF
  89.     SET ZMODEM AUTO OFF        ; Automatic ZMODEM (user must say 'z')
  90.     SET ZMODEM RECOVER OFF        ; No ZMODEM recovery
  91. ;
  92. ;    Replace above values from BBSDAT, if that script exists
  93. ;
  94.     IF ISSC "BBSDAT"
  95.        FCALL "BBSDAT"
  96.     ELSE
  97.        S10 = "_SCRIPT"              ; Get current script fname
  98.        GOSUB Parse_Fname        ; Extract drive:Subdir from name
  99.        S10 = S10*"\BBSDAT"          ; Make new name
  100.        IF ISSC S10 FCALL S10    ; Invoke it if its THERE
  101.        ENDIF
  102. ;
  103. ;    Initialize variables that must be constant
  104. ;
  105.     SUBDIR S29            ; Read current subdir
  106.     DLDIR S28            ; Read current download subdir
  107.     IF NOT ISFILE S22*"\BBS-User"   ; Test presence of user file
  108.        WCLOSE            ; Clear 'initializing' window
  109.        GOTO NoUser            ; .. Skip if not found
  110.        ENDIF
  111. ;
  112. ;    Initialize other values
  113. ;
  114.     SET PORT S20(0:3)        ; Starting port
  115.     SET INAFTER OFF         ; Turn off init after hangup
  116.  
  117.     SET ALARM OFF            ; Turn off alarm
  118.     SET ATIME 1            ; Set alarm time to 1 second
  119.     CHDIR S22            ; Set to our subdirectory
  120.     SET DLDIR S23            ; Set DLDIR
  121.     LEGEND "Scripted BBS (1.3);  Press ESC to terminate or to CHAT."
  122.     WCLOSE                ; End init (before ON ESC)
  123.     ON ESCAPE GOSUB Escape        ; Enter chat mode on operator escape
  124. ;
  125. ;    If this is a restart, pickup at the main prompt
  126. ;
  127.     SET PORT S20(0:3)        ; Starting port
  128.     IF ISFILE "HOSTTEMP.STR" and ISFILE "HOSTTEMP.BAT"
  129.        SET RECHO ON         ; Restart - need to reenable
  130.        LOAD STRING "HOSTTEMP.STR"   ; Restore previous values
  131.        SET FLAG(1) S0(0:2)        ; Set flags back too
  132.        SET FLAG(2) S0(3:5)        ; Set flags back too
  133.        SET FLAG(3) S0(6:8)        ; Set flags back too
  134.        DELETE "HOSTTEMP.STR"        ; Done w/the file
  135.        S9 = "* Return from drop-to-DOS"
  136.        GOSUB Log_Item        ; Log it
  137.        CLOG S9
  138.        GOTO Main_Prompt
  139.        ENDIF
  140. ;
  141. ;    Initialize values that change port setting, and start a new call
  142. ;
  143.     TRANSMIT "_MESCAPE"             ; Initialize modem (modem escape)
  144.     SET BAUD S20(5:8)        ; Starting speed
  145.     S9 = "* BBS script loaded"      ; Set text of msg
  146.     CLOG S9             ; .. to call log
  147.     GOSUB Log_Item            ; .. and to BBS-Log
  148.     GOTO Restart            ; Branch around subroutines
  149. ; -----------------------------------------------------------------------
  150. ;    Subroutine: Parse drive:subdirectory from file name
  151. ;
  152. ;    S10 passes fully name        S10 returns drive:subdirectory
  153. ;                    S11 returns file name
  154. ;    N10,N11 are scratch values
  155. ; -----------------------------------------------------------------------
  156. ;
  157. Parse_Fname:
  158.     LENGTH S10 N10            ; Find length of string
  159.     FOR N11 = (N10-1),0,-1        ; Scan backwards through string
  160.         IF STRCMP S10(N11:N11) ":" or STRCMP S10(N11:N11) "\" GOTO PAFN100
  161.         ENDFOR
  162.     S11 = S10            ; No drive or path
  163.     S10 = ""                        ; Return null drive:path spec
  164.     RETURN
  165. ;
  166. ;    Extract drive and path from name; N11 points to ":" or "\"
  167. ;
  168. PAFN100:
  169.     S11 = S10(N11+1:N10)        ; Extract name portion
  170.     IF STRCMP S10(N11:N11) "\" DEC N11
  171.     S10 = S10(0:N11)        ; Save ":", remove last "\"
  172.     RETURN
  173. ; -----------------------------------------------------------------------
  174. ;    Subroutine: No user ID file
  175. ;
  176. ;    S0 is used as scratch
  177. ; -----------------------------------------------------------------------
  178. ;
  179. NoUser:
  180. ;
  181. ;    Issue a pop-up
  182. ;
  183.     LEGEND "Scripted BBS (1.3);  Error initializing"
  184.     WOPEN 10,10,17,70 (default) NoUser_End
  185.     ATSAY 10,12 (default) " BBS initialization "
  186.     ATSAY 11,12 (default) "There is no user ID file (BBS-User) to be found on the"
  187.     ATSAY 12,12 (default) "subdirectory: "*S22
  188.     ATSAY 14,12 (default) "The script BBSETUP must be used to identify the subdir-"
  189.     ATSAY 15,12 (default) "ectory used by this BBS, and to create and maintain the"
  190.     ATSAY 16,12 (default) "files it uses."
  191.     ATSAY 17,29 (default) " Press any key to continue "
  192.     KEYGET S0
  193. NoUser_End:
  194.     WCLOSE                ; Close window we opened
  195.     GOTO End            ; Finish - no changes need be reset
  196. ;
  197. ; -----------------------------------------------------------------------
  198. ;    Subroutine: Operator ESCAPE
  199. ; -----------------------------------------------------------------------
  200. ;
  201. Escape:
  202.     CURSOR N98,N97
  203.     WOPEN     10,1  20,78 (default) ESC_ESC
  204.     ATSAY     10,3  (default) " BBS Operator menu "
  205.     ATSAY     12,3  (default) "1) Terminate the BBS"
  206.     IF FLAG(3)                ; Not during call
  207.        ATSAY 13,3  (default) "2) Enter chat with caller"
  208.     ELSE
  209.        ATSAY 13,3  (default) ".. No caller currently on "
  210.        ENDIF
  211.     ATSAY     14,3  (default) "3) Cancel this window"
  212.     ATSAY     15,1  (default) "├────────────────────────────────────────────────────────────────────────────┤"
  213.     IF ISSCRIPT "BBMAINT" and NOT FLAG(3)   ; Not during call
  214.        ATSAY 16,3  (default) "4) Invoke BBS maintenance scripts"
  215.     ELSE
  216.        ATSAY 16,3  (default) ".. Maintenance script not available"
  217.        ENDIF
  218.     IF ISSCRIPT "BBSETUP" and NOT FLAG(3)   ; Not during call
  219.        ATSAY 17,3  (default) "5) Invoke BBS setup script"
  220.     ELSE
  221.        ATSAY 17,3  (default) ".. Setup script not available"
  222.        ENDIF
  223.     ATSAY     18,1  (default) "├────────────────────────────────────────────────────────────────────────────┤"
  224.     ATSAY     19,3  (default) "Select item: "
  225.     ATSAY     20,31 (default) " Press ESC to cancel "
  226.     LOCATE 19,16
  227.     KEYGET S0
  228.     WCLOSE
  229.     LOCATE N98,N97
  230. ;
  231. ;    Interpret the response
  232. ;
  233.     SWITCH S0                ; Interpret resp in S0
  234.        CASE "1"                             ; Terminate
  235.           GOTO End
  236.        ENDCASE
  237.        CASE "2"                             ; Chat
  238.           IF FLAG(3) GOTO Chat
  239.        ENDCASE
  240.        CASE "3"                             ; Bulletin
  241.           RETURN
  242.        ENDCASE
  243.        CASE "4"                             ; Maintenance
  244.           GOSUB EndBBS            ; Terminate BBS
  245.           IF ISFILE "BBMaint" EXECUTE "BBMaint"
  246.        ENDCASE
  247.        CASE "5"                             ; Setup
  248.           GOSUB EndBBS            ; Terminate BBS
  249.           IF ISFILE "BBSetup" EXECUTE "BBSetup"
  250.        ENDCASE
  251.  
  252.        DEFAULT                ; None of the above
  253.           SOUND 100,100            ; Rsapberry
  254.        ENDCASE
  255.     ENDSWITCH
  256.     GOTO Escape
  257. ;
  258. ;    Escape during ESCAPE window
  259. ;
  260. ESC_ESC:
  261.     S0 = "3"                                ; Selection = return
  262.     RETURN                    ; We're done
  263. ;
  264. ; -----------------------------------------------------------------------
  265. ;    Subroutine: End of BBS
  266. ; -----------------------------------------------------------------------
  267. ;
  268. End:
  269.     GOSUB EndBBS
  270.     EXIT
  271. ;
  272. ; -----------------------------------------------------------------------
  273. ;    Subroutine: End of BBS
  274. ;    4/93: Transmit MINIT *before* RESET, in case modem in use by BBS
  275. ;          is not modem default for COM-AND (MINIT turns off answer)
  276. ; -----------------------------------------------------------------------
  277. ;
  278. EndBBS:
  279.     SET TTHRU OFF            ; Inhibit type thru
  280.     WOPEN 10,1  12,78 (default)
  281.     ATSAY 11,3 (default) "Terminating BBS.. "
  282.  
  283.     HANGUP                ; Hangup the phone
  284.     S9 = "* BBS script terminated"  ; Set msg to log
  285.     CLOG S9             ; Log completion
  286.     GOSUB Log_Item            ; .. both places
  287.     SET DLDIR S28            ; Reset dldir
  288.     CHDIR S29            ; Reset to default directory
  289.     MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J"
  290.     TRAN "_MINIT"                   ; Initialize modem from defaults
  291.     DELETE "\HOSTTEMP.TXT"          ; Cleanup
  292.  
  293.     RESET                ; Reset default values
  294.     WCLOSE                ; Close window opened above
  295.     CLEAR                ; Clear screen
  296.     IF ISSC "$$$SCHED" EXECUTE "$$$SCHED"; And chain back after call
  297.     RETURN                ; We're done
  298. ; -----------------------------------------------------------------------
  299. ;    Subroutine: Chat mode: Operator entered escape
  300. ;
  301. ;    S0 is used as scratch
  302. ; -----------------------------------------------------------------------
  303. ;
  304. Chat:
  305. ;
  306. ;    Start chat mode.
  307. ;
  308.     TRAN "^M^J"                     ; Send a c/r
  309.     TRAN "^M^JOperator initiated chat mode..."
  310.     S2 = "_LEGEND"                  ; Save previous legend
  311.     LEGEND "Scripted BBS (1.3);  Chat mode; null entry at prompt to exit"
  312. ;
  313. ;    Read from the operator
  314. ;
  315. Chat_Loop:
  316.     MESS "^M^JSYSOP: "              ; Prompt
  317.     GET S0 80            ; Read from kbd
  318.  
  319.     IF NULL S0            ; If blank entry
  320.        MESS "Continue? (Y/N, cr=y): "
  321.        GET S0 2            ; Read a response
  322.        IF FIND S0 "N"               ; If response was no
  323.           TRAN "^M^JChat terminated by SYSOP"
  324.           LEGEND S2         ; Restore previous legend
  325.           RETURN            ; Return to what we were doing
  326.           ENDIF
  327.        S0 = " "                     ; Make a blank line
  328.        ENDIF
  329.     TRAN "^M^JSYSOP: "
  330.     TRAN S0             ; Send the line
  331. ;
  332. ;    Read from the caller
  333. ;
  334.     MESS "Caller: "                 ; NO c/r req'd
  335.     TRAN "^M^JCaller: "             ; Prompt
  336.     GOSUB Read_Comm         ; read the comm port
  337.     IF FLAG(0)            ; If caller disconn
  338.        MESS "^M^JCaller disconnected" ; Inform sysop
  339.        LEGEND S2            ; Restore previous legend
  340.        RETURN            ; ANd return
  341.        ENDIF
  342.     GOTO Chat_Loop            ; And continue
  343. ; -----------------------------------------------------------------------
  344. ;    Subroutine: Limit time on-line
  345. ;    .. S6 -> Time of logon
  346. ;    .. N0 -> Max minutes allowed
  347. ;
  348. ;    FLAG(0) off -> Time remaining
  349. ;        on --> Disconnect the caller
  350. ;
  351. ;    S9 and N18,N19 are used as scratch
  352. ; -----------------------------------------------------------------------
  353. ;
  354. Limit_Time:
  355. ;
  356. ;    If privileged user, just return true
  357. ;
  358.     IF FLAG(1)            ; If privileged user
  359.        SET FLAG(0) OFF        ; Return OK
  360.        RETURN            ; Return to caller
  361.        ENDIF
  362. ;
  363. ;    Convert times to numeric quantities
  364. ;
  365.     TIME S9 1            ; Get current time (military fmt)
  366.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight
  367.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight
  368. ;
  369. ;    And test the time remaining
  370. ;
  371.     IF GT N18 N19            ; If timeout on the RGET
  372.        N19 = N19+1440        ; Allow wrap accross midnight
  373.        ENDIF
  374.     N19 = N19-N18            ; COmpute time on
  375.  
  376.     IF GT N19 N0            ; Test against logon determined time
  377.        TRAN "^M^JYour alotted time has expired..."
  378.        TRAN "^M^JYou are being disconnected."
  379.        SET FLAG(0) ON        ; Indicate disconnect
  380.        RETURN            ; RETURN to caller
  381.        ENDIF
  382. ;
  383. ;    Return 'OK'
  384. ;
  385.     SET FLAG(0) OFF         ; Report to caller
  386.     RETURN                ; Return with text in S9
  387. ; -----------------------------------------------------------------------
  388. ;    Subroutine: Read from the caller into S9 (modified 7/93 for kbd)
  389. ;    .. This handles 'disconnect' and timeouts, and allows sysop typethru
  390. ;    -----------------------------------------------------------------
  391. ;    S27, S28, S29, N30, N27 and TIMER(0) are used in this procedure
  392. ;    S9 returns the text read (if any)
  393. ;
  394. ;    FLAG(0) off -> Line read correctly
  395. ;        on --> Disconnect or timeout
  396. ; -----------------------------------------------------------------------
  397. ;    Test timeout
  398. ;
  399. Read_Comm:
  400.     IF FLAG(3)            ; If user logged on now
  401.        GOSUB Limit_Time        ; Test time on-line
  402.        IF FLAG(0) RETURN        ; If error returns set, end proc here
  403.        ENDIF
  404. ;
  405. ;    Initialize for loop
  406. ;
  407.     S9 = ""                         ; Clear buffer
  408.     N27 = 0             ; Size of S9 buffer
  409.     SET RMODE BINARY        ; Binary comm read
  410. ;
  411. ;    Now, sit on the COMM port waiting for a read
  412. ;
  413. RCOM100:
  414.     SET TIMER            ; Set timer for now
  415.     WHILE NOT RECEIVE and NOT HITKEY; Loop, awaiting activity
  416.        IF NOT CONNECTED GOTO RCOM500; If modem reports CD dropped
  417.        TSINCE N28,N29,N30        ; Look at time since start
  418.        IF NOT ZERO N28 or N29 GT 3 GOTO RCOM400
  419.        ENDWHILE
  420. ;
  421. ;    Catch comm chars
  422. ;
  423.     IF RECEIVE            ; Something on the comm port
  424.        RGET S27 1 180        ; .. so read it
  425.        IF FIND S27 "^M" GOTO RCOM300; Catch c/r here
  426.        GOTO RCOM200         ; And skip to process
  427.        ENDIF
  428. ;
  429. ;    Catch sysop (kbd) chars
  430. ;
  431.     IF HITKEY            ; Something on the kbd
  432.        KEYGET S27            ; .. so read it
  433.        IF FIND S27(0:1) "0d"        ; Allow sysop to do c/r
  434.           TRANS "!"                 ; Echo to caller
  435.           GOTO RCOM300        ; go handle c/r
  436.           ENDIF
  437.        IF FIND S27(0:1) "08"        ; Allow sysop to do b/s
  438.           ITOC 8 S27        ; Place in buffer
  439.           S27(1:79) = ""            ; and remove remainder
  440.           ENDIF
  441.        LENGTH S27 N28        ; Take length of read
  442.        IF N28 GT 1            ; Must be ascii char
  443.           SOUND 100,400        ; Else, bronx cheer
  444.           GOTO RCOM100        ; .. and throw away
  445.           ENDIF
  446.        IF NOT (FIND S27 "^H" and N27 EQ 0) TRANS S27; Echo char to caller
  447.        CURSOR N28 N29        ; Read cursor pos
  448.        ATSAY N28 N29 (text) S27    ; Echo to console
  449.        IF FIND S27 "^H"             ; If backspace entered
  450.           IF N27 GT 0 DEC N29    ; Backspace cursor position
  451.        ELSE             ; Not a backspace
  452.           INC N29            ; Increment col pos
  453.           ENDIF
  454.        LOCATE N28 N29        ; Set new cursor pos
  455.        ENDIF
  456. ;
  457. ;    Handle the received char  - 1st, look for backspaces
  458. ;
  459. RCOM200:
  460.     IF FIND S27(0:0) "^H"           ; Backspace
  461.        IF ZERO N27 GOTO RCOM100    ; Don't backspace past rightmost
  462.        DEC N27            ; Decrement count so far
  463.        IF N27 GT 0            ; If anything remains in buffer
  464.           S9 = S9(0:N27-1)        ; .. remove last char
  465.        ELSE
  466.           S9 = ""                   ; Make null again
  467.           ENDIF
  468.        GOTO RCOM100         ; And continue looping
  469.        ENDIF
  470. ;
  471. ;    Buffer up anything else
  472. ;
  473.     S9 = S9*S27            ; Concatenate char
  474.     INC N27             ; Increment count bufferred
  475.     IF N27 LT 80 GOTO RCOM100    ; Loop if we haven't 80
  476. ;
  477. ;    Look at the buffer we've collected
  478. ;
  479. RCOM300:
  480.     FIND S9 "NO CARRIER"            ; Test for message from modem
  481.     IF FOUND GOTO RCOM500        ; If modem didn't report 'CD' true
  482. ;
  483. ;    Return 'text read'
  484. ;
  485.     SET RMODE ASCII         ; Normal comm read restored
  486.     SET FLAG(0) OFF         ; Report to caller
  487.     RETURN                ; Return with text in S9
  488. ;
  489. ;    Timeout on the call
  490. ;
  491. RCOM400:
  492.     TRAN "^M^J... autodisconnect due to timeout^M^J"
  493.     MESSAGE "^M^J... autodisconnect due to timeout"
  494.     GOTO RComm_Exit         ; Exit cycle in the usual manner
  495. ;
  496. ;    Disconnect was reported.
  497. ;
  498. RCOM500:
  499.     MESSAGE  "^M^JCaller disconnected"
  500. ;
  501. ;    Read_Comm error exit
  502. ;
  503. RComm_Exit:
  504.     SET RMODE ASCII         ; Normal comm read restored
  505.     SET FLAG(0) ON            ; Report to caller
  506.     RETURN                ; Return to the caller
  507. ; -----------------------------------------------------------------------
  508. ;    Subroutine: Display the # of allotted minutes remaining
  509. ;    .. S6 -> Time of logon
  510. ;    .. N0 -> Max minutes allowed
  511. ;
  512. ;    S9 and N18,N19 are used as scratch
  513. ; -----------------------------------------------------------------------
  514. ;
  515. Display_Limit:
  516. ;
  517. ;    If privileged user, just return (no message)
  518. ;
  519.     IF FLAG(1) RETURN        ; If privileged user, rtn to caller
  520. ;
  521. ;    Convert times to numeric quantities
  522. ;
  523.     TIME S9 1            ; Get current time (military fmt)
  524.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight
  525.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight
  526. ;
  527. ;    Compute the time remaining
  528. ;
  529.     IF GT N18 N19            ; If timeout on the RGET
  530.        N19 = N19+1440        ; Allow wrap accross midnight
  531.        ENDIF
  532.     N19 = N0-(N19-N18)        ; Compute remaining time
  533. ;
  534. ;    Display the quantity and we're done
  535. ;
  536.     STRFMT S9 "^M^J(%d minutes remaining)" N19
  537.     TRAN S9
  538.     RETURN                ; Return with text in S9
  539. ; -----------------------------------------------------------------------
  540. ;    Subroutine: Logon - ID/password are in S1 (0:15)
  541. ;
  542. ;    On exit:
  543. ;       FLAG(0) ON -> indicate falure of logon
  544. ;       FLAG(1) ON -> if logon successful to indicate privileged access
  545. ; -----------------------------------------------------------------------
  546. ;
  547. Logon:
  548.     FOPENI "BBS-User" TEXT          ; OPEN file for input
  549.     IF FAILED            ; if open failed
  550.        SET FLAG(0) ON        ; Report an error
  551.        RETURN            ; Return to caller
  552.        ENDIF
  553. ;
  554. ;    Read records from BBS-User
  555. ;
  556. Logon_Loop:
  557.     READ S9 80 N19            ; Read a record      * COM-AND
  558.     IF EOF                ; Test for EOF
  559.        FCLOSEI            ; CLose the input file
  560.        SET FLAG(0) ON        ; Report an error
  561.        RETURN            ; Return to caller
  562.        ENDIF
  563.  
  564.     FIND S9(0:0) "<"                ; Test for comment line
  565.     IF FOUND GOTO Logon_Loop    ; IF "<" found,
  566.  
  567.     SWITCH S1            ; Test ID/Password
  568.        CASE S9(0:15)        ; .. against record
  569.           GOTO Logon_OK        ; We have a match
  570.        ENDCASE
  571.     ENDSWITCH
  572.     GOTO Logon_Loop         ; Read the next record
  573. ;
  574. ;    We have a successful logon
  575. ;
  576. Logon_OK:
  577.     SET FLAG(1) OFF         ; Default no privilege
  578.     SET FLAG(3) ON            ; Set flag to say 'logged-on'
  579.     N0 = 60             ; Set time limit for non-privileged user
  580.  
  581.     FIND S9(16:16) "P"              ; Test for privilege
  582.     IF FOUND            ; IF "P" found,
  583.        SET FLAG(1) ON        ; Indicate privilege
  584.        N0 = 3000            ; 50 hours ought to be enough
  585.        ENDIF
  586.  
  587.     TIME S6 1            ; Set time of logon (military fmt)
  588.  
  589.     FCLOSEI             ; CLose the input file
  590.     SET FLAG(0) OFF         ; Indicate successful logon
  591.     RETURN
  592. ; -----------------------------------------------------------------------
  593. ;    Subroutine: DispFile: Display a file
  594. ;
  595. ;    On entry:
  596. ;       S8 -> The file to be opened (and displayed)
  597. ;       S9 -> A message to be displayed if the file D.N.E
  598. ; -----------------------------------------------------------------------
  599. ;
  600. Disp_File:
  601.     IF ISFILE S8            ; If File exists
  602.        TRAN "^M^J"                  ; Send an initial delimiter
  603.        SENDFILE ASCII S8        ; Send the file
  604.        RETURN            ; Return to caller
  605.        ENDIF
  606.  
  607.     IF ISFILE S22&"\"*S8            ; If file exists on primary subdir
  608.        TRAN "^M^J"                  ; Send an initial delimiter
  609.        SENDFILE ASCII S22&"\"*S8    ; Send the file
  610.        RETURN            ; Return to caller
  611.        ENDIF
  612.  
  613.     TRAN S9             ; Display the alternative message
  614.     RETURN                ; Return to caller
  615. ; -----------------------------------------------------------------------
  616. ;    Subroutine: Log_Item: Add a line to the activity log
  617. ;
  618. ;    On entry:
  619. ;       S9 -> The line to be added
  620. ;
  621. ;    S7 is used as a scratch reg; S9 is modified
  622. ; -----------------------------------------------------------------------
  623. ;
  624. Log_Item:
  625.     FOPENO S22&"\BBS-LOG" TEXT APPEND ; OPEN file for output
  626.     IF FAILED RETURN        ; If open failed, rtn here
  627.  
  628.     DATE S7             ; Get current date
  629.     CONCAT S9(59) S7        ; Add date to S9 line
  630.     TIME S7 1            ; Get current time (military fmt)
  631.     CONCAT S9(70) S7        ; Add time to S9 line
  632.  
  633.     WRITE S9            ; Write a record     * COM-AND
  634.     WRITE "^M"                      ; Write a cr/lf          * COM-AND
  635.     FCLOSEO             ; CLose the output file
  636.     RETURN                ; And we're done
  637. ;
  638. ; -----------------------------------------------------------------------
  639. ;    Subroutine: Copy text to an open file (write a message)
  640. ;    The output file must be opened by the caller
  641. ;
  642. ;    S9, N18 are used as scratch
  643. ;    N20 carries the current linenum (and must be preserved on GOSUBs)
  644. ; -----------------------------------------------------------------------
  645. ;
  646. Copy_Text:
  647.     N20 = 0
  648. ;
  649. ;    Prompt with a line number, and read a line of text in response
  650. ;
  651. Copy_Loop:
  652.     INC N20             ; Increment line counter
  653.     S9 = N20 & ":  ^H"              ; Convert to decimal ascii
  654.     TRAN S9             ; Transmit line number
  655.  
  656.     GOSUB Read_Comm         ; Read a response
  657.     IF FLAG(0) RETURN        ; If error, make end of text
  658. ;
  659. ;    If the line is not blank, copy it to the output file
  660. ;
  661.     LENGTH S9 N18            ; Get proper length
  662.     IF NOT ZERO N18         ; Test for an empty line
  663.        PRESERVE S9            ; Preserve "!"s and "^"s
  664.        WRITE S9            ; Write the line     * COM-AND
  665.        IF FAILED            ; if write failed
  666.           TRAN "Error recording text - please try later^M^J"
  667.           RETURN            ; Return to caller
  668.           ENDIF
  669.        WRITE  "!"                   ; And a record delimiter * COM-AND
  670.        GOTO Copy_Loop        ; And loop
  671. ;
  672. ;    A blank line was entered - ask if we are to terminate
  673. ;
  674.     ELSE
  675.        TRAN "^M^JComplete? (Y/N, cr=n): "  ; Ask if this is end of input
  676.        GOSUB Read_Comm        ; Read a response
  677.        IF FLAG(0) RETURN        ; If error - disconn
  678.        IF NOT FIND S9 "Y"           ; Test for positive response
  679.           WRITE "!"                 ; Write a blank line
  680.           GOTO Copy_Loop        ; COntinue copying
  681.           ENDIF
  682.        ENDIF
  683.     RETURN                ; Return - we're done
  684. ; -----------------------------------------------------------------------
  685. ; ----- Begin ... reset values, and set the modem to accept a call
  686. ; -----------------------------------------------------------------------
  687. ;
  688. Restart:
  689.     CHDIR S22            ; Reset to default drive
  690.     SET RECHO OFF            ; Turn off echo for us
  691.     SET RDISP OFF            ; Turn on display of received chars
  692.     CLEAR                ; Clear screen
  693.     LOCATE 0,0            ; Set to home
  694.  
  695.     SET FLAG(1) OFF         ; Turn off privilege flag
  696.     SET FLAG(2) OFF         ; Turn off CHDIR flag
  697.     SET FLAG(3) OFF         ; Turn off logged-on flag
  698. ;
  699. ;    Go into auto answer (echo off, answer on 3rd)
  700. ;    Also: Return result codes, word form, with CONNECT 1200
  701. ;
  702.     IF NOT ISSC "$$$SCHED"          ; If scheduler didn't invoke us
  703.        HANGUP            ; HANGUP and leave modem in cmd mode
  704.        MESSAGE "^M^JWaiting..."
  705.        PAUSE 3            ; Wait 3 secs for modem to settle
  706.        ENDIF
  707.     SET BAUD S20(5:8)        ; Starting speed
  708.     TRANSMIT S21            ; Transmit modem initialization
  709. ;
  710. ; -----------------------------------------------------------------------
  711. ; ----- Wait for a connect
  712. ; -----------------------------------------------------------------------
  713. ;
  714. Wait_Connect:
  715.     RGET S9 80 180            ; Wait for a line
  716.     IF FAILED GOTO Wait_Connect    ; If nothing was read
  717.  
  718.     FIND S9 "NO CARRIER"            ; Look for a disconn
  719.     IF FOUND GOTO Exit
  720.  
  721.     FIND S9 "CONNECT"               ; Anything else BUT CONNECT
  722.     IF NOT FOUND GOTO Wait_Connect    ; .. waits
  723. ;
  724. ; ----- Connection established: Adjust our linespeed if need be
  725. ;
  726.     GOSUB AutoBaud            ; Change rate according to CONNECT MSG
  727. ;
  728. ; ----- Issue a greeting
  729. ;
  730.     PAUSE 3             ; Let the modem settle
  731.     RFLUSH                ; Clear line
  732.  
  733.     SET RECHO ON            ; Turn on echo (echo back to caller)
  734.     SET RDISP ON            ; Turn on display of received chars
  735.     PAUSE 1             ; MOdem settling
  736.  
  737.     S9 = "^M^JThe Flying Scotsman greets you!! ^M^J"
  738.     S8 = "BBS-Welc"                 ; Set file name
  739.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  740.  
  741.     N10 = 0             ; Set count of logon tries
  742. ;
  743. ; ----- Request an ID
  744. ;
  745. ID_Query:
  746.     MESS "^M^JID prompt: "          ; Local console indicator
  747.     TRANSMIT "^M^JEnter your ID (or enter GUEST): "
  748.     GOSUB Read_Comm         ; Read into S9
  749.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn
  750.  
  751.     IF NULL S9            ; Test for nothing entered
  752.        INC N10            ; Count it as a logon try
  753.        IF GE N10 3 GOTO Logon_Fail    ; If tried 3 times to logon quit
  754.        GOTO ID_Query        ; Require an ID
  755.        ENDIF            ; End of empty test
  756.  
  757.     SWITCH S9
  758.        CASE "GUEST"                 ; Test for nothing entered
  759.           GOSUB Register        ; Try to register the caller
  760.           GOTO Exit         ; And exit the sequence
  761.        ENDCASE            ; End of GUEST test
  762.     ENDSWITCH            ; End of ID test
  763.     S1 = S9(0:7)            ; Save 8 chars of ID
  764.     UPPER S1            ; Make ID upper case
  765. ;
  766. ; ----- Request a password
  767. ;
  768. Password_Query:
  769.     TRANSMIT "^M^JEnter your password: "
  770.     SET RECHO OFF            ; Turn of echo of received text
  771.     SET RDISPLAY OFF        ; Turn off echo to console too
  772.  
  773.     GOSUB Read_Comm         ; Read into S9
  774.     SET RECHO ON            ; Restore echo
  775.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn
  776.     SET RDISPLAY ON         ; Turn on echo to console again
  777.  
  778.     IF NULL S9            ; Test for nothing entered
  779.        INC N10            ; Count it as a logon try
  780.        IF GE N10 3 GOTO Logon_Fail    ; If tried 3 times to logon quit
  781.        GOTO Password_Query        ; Require a password
  782.        ENDIF            ; End of empty test
  783. ;
  784. ;    Build the ID/password string and test logon
  785. ;
  786.     S1(8:79) = S9(0:7)        ; Add password to S1
  787.     GOSUB Logon            ; Test logon
  788.     IF NOT FLAG(0)            ; If flag(0) returns reset, its ok
  789.        S9 = "Logon: "*S1(0:7)       ; Set activity
  790.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  791.        SET FLAG(2) OFF        ; Indicate no CHDIR this user
  792.        S1 = S1(0:7)         ; Throw away password
  793.        CLOG "* BBS logon: "*S1
  794.        TRAN "^M^J"                  ; Space one line fror caller
  795.        GOTO Main_Prompt        ; OK - we're on
  796.        ENDIF
  797. ;
  798. ;    Unrecognized ID/password
  799. ;
  800. Logon_Fail:
  801.     TRAN "Unrecognized ID/Password^M^J"
  802.     INC N10             ; Increment count of tries
  803.     IF GE N10 3            ; If tried 3 times to logon
  804.        TRAN "You have exceeded the number of tries allowed for logon^M^JBye...^M^J"
  805.        MESS "^M^JLogon attempts failed^M^J"
  806.        S9 = "Failed logon"          ; Report to log
  807.        GOSUB Log_Item
  808.        GOTO Exit            ; ANd hangup
  809.        ENDIF
  810.     GOTO ID_Query            ; And try again
  811. ; -----------------------------------------------------------------------
  812. ; ----- Main Loop: Prompt for a command and interpret the return
  813. ; -----------------------------------------------------------------------
  814. ;
  815. Main_Prompt:
  816.     MESS "^M^JMain prompt: "        ; Local console indicator
  817.     GOSUB Display_Limit        ; Report amount of time remaining
  818.  
  819.     IF NOT FLAG(1)            ; According to privilege
  820.        S9 = "^M^JC)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  821.        S8 = "BBS-NpMn"              ; Set file name
  822.     ELSE
  823.        S9 = "^M^JP)rivileged, C)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  824.        S8 = "BBS-PrMn"              ; Set file name
  825.        ENDIF
  826.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  827. ;
  828. ;    Keep just the first char entered
  829. ;
  830.     GOSUB Read_Comm         ; Read into S9
  831.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  832.  
  833.     LJ S9                ; Left justify S9
  834.     S9 = S9(0:0)            ; Keep just the first char
  835. ;
  836. ;    Perform commands
  837. ;
  838.     SWITCH S9            ; Test the entry
  839.     ;
  840.     ;    Alarm
  841.     ;
  842.        CASE "A"                     ; Signal request for chat mode
  843.           GOTO Alarm
  844.        ENDCASE
  845.     ;
  846.     ;    Mail
  847.     ;
  848.        CASE "M"                     ; Messages
  849.           GOTO Mail_Command
  850.        ENDCASE
  851.     ;
  852.     ;    Files command
  853.     ;
  854.        CASE "F"                     ; Files
  855.           GOTO File_Command
  856.        ENDCASE
  857.     ;
  858.     ;    Comment command
  859.     ;
  860.        CASE "C"                     ; Leave a note
  861.           GOTO Comment
  862.        ENDCASE
  863.     ;
  864.     ;    Bulletin command
  865.     ;
  866.        CASE "B"                     ; Read bulletins
  867.           GOTO Bull_Command
  868.        ENDCASE
  869.     ;
  870.     ;    Exit command
  871.     ;
  872.        CASE "E"                     ; Exit
  873.           GOTO Logoff        ; Transmit acknowlegement and Exit
  874.        ENDCASE
  875.     ;
  876.     ;    Privileged command
  877.     ;
  878.        CASE "P"                     ; Privilege
  879.           IF FLAG(1) GOTO Priv_Prompt; Execute only if privileged
  880.        ENDCASE
  881.     ENDSWITCH
  882. ;
  883. ;    Invalid command
  884. ;
  885.     TRAN "^M^JCommand not recognized... try again^M^J"
  886.     GOTO Main_Prompt
  887. ;
  888. ; -----------------------------------------------------------------------
  889. ;    Logoff
  890. ; -----------------------------------------------------------------------
  891. ;
  892. Logoff:
  893.     CHDIR S22            ; Set to our subdirectory
  894.     TRAN "^M^JOK... Bye^M^J"        ; Say g'bye and fall thru to Exit
  895.     S9 = "Logoff: "*S1(0:7)         ; Set activity
  896.     CLOG S9             ; Log here too
  897.     GOSUB Log_Item            ; Add S9 to BBS-LOG
  898. ;
  899. ; -----------------------------------------------------------------------
  900. ;    General exit routine - don't GOTO from within a subroutine!!!
  901. ; -----------------------------------------------------------------------
  902. ;
  903. Exit:
  904.     S9 = "* BBS cycled"             ; Set activity
  905.     CLOG S9             ; Call log it too
  906.     GOSUB Log_Item            ; Add S9 to BBS-LOG
  907.     MESS "^G"                       ; Beep console to indicate exit
  908.     IF ISSC "$$$SCHED" GOTO End     ; Hook for scheduler return
  909.     GOTO Restart            ; And start over
  910. ;
  911. ; -----------------------------------------------------------------------
  912. ;    Alarm routine - make some noise, in hopes we can upset somebody
  913. ; -----------------------------------------------------------------------
  914. ;
  915. Alarm:
  916.     SOUND 440 500            ; 1/2 sec  Scale in 'A'
  917.     SOUND 493 100            ; 1/10 sec
  918.     SOUND 554 100            ; 1/10 sec
  919.     SOUND 587 100            ; 1/10 sec
  920.     SOUND 659 100            ; 1/10 sec
  921.     SOUND 739 100            ; 1/10 sec
  922.     SOUND 830 100            ; 1/10 sec
  923.     SOUND 880 500            ; 1/2 sec
  924.     GOTO Main_Prompt        ; And start over
  925. ; -----------------------------------------------------------------------
  926. ; ----- Privileged commands submenu.
  927. ; -----------------------------------------------------------------------
  928. ;
  929. Priv_Prompt:
  930.     MESS "^M^JPrivilege prompt: "   ; Local console indicator
  931.     GOSUB Display_Limit        ; Report amount of time remaining
  932.     IF NULL S26
  933.        S9 = "^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
  934.     ELSE
  935.        S9 = "^M^JL)ist, P)ath, S)ubdir, doorW)ay, D)OS, M)ain or E)xit: "
  936.        ENDIF
  937.     S8 = "BBS-PPMn"                 ; Set file name
  938.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  939. ;
  940. ;    Keep just the first char entered
  941. ;
  942.     GOSUB Read_Comm         ; Read into S9
  943.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  944.  
  945.     LJ S9                ; Left justify S9
  946.     S9 = S9(0:0)            ; Keep just the first char
  947. ;
  948. ;    Execute a command
  949. ;
  950.     SWITCH S9            ; Test the entry
  951.     ;
  952.     ;    List command
  953.     ;
  954.        CASE "L"                     ; List
  955.           GOTO DIR
  956.        ENDCASE
  957.     ;
  958.     ;    Subdir command
  959.     ;
  960.        CASE "S"                     ; Chdir
  961.           GOTO CHDIR
  962.        ENDCASE
  963.     ;
  964.     ;    Pathlist command
  965.     ;
  966.        CASE "P"                     ; Pathlist
  967.           GOTO PATHLIST
  968.        ENDCASE
  969.     ;
  970.     ;    Shell command
  971.     ;
  972.        CASE "D"                     ; Shell
  973.           GOTO Shell
  974.        ENDCASE
  975.     ;
  976.     ;    Doorway command
  977.     ;
  978.        CASE "W"                     ; Drop-to-DOS and do doorway
  979.           GOTO DropDOS
  980.        ENDCASE
  981.     ;
  982.     ;    Main command
  983.     ;
  984.        CASE "M"                     ; Go back to main prompt
  985.           GOTO Main_Prompt
  986.        ENDCASE
  987.     ;
  988.     ;    Exit command
  989.     ;
  990.        CASE "E"                     ; Exit
  991.           GOTO Logoff        ; Transmit acknowlegement and Exit
  992.        ENDCASE
  993.     ENDSWITCH
  994. ;
  995. ;    Invalid command
  996. ;
  997.     TRAN "^M^JCommand not recognized... try again^M^J"
  998.     GOTO Priv_Prompt
  999. ; -----------------------------------------------------------------------
  1000. ;    Privileged user: CHDIR... Query for a path.
  1001. ; -----------------------------------------------------------------------
  1002. ;
  1003. CHDIR:
  1004.     MESS "^M^JCHDIR Command: "      ; Local console indicator
  1005.     TRAN "^M^JEnter the drive:subdirectory: "
  1006.  
  1007.     GOSUB Read_Comm         ; Read into S9
  1008.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1009.  
  1010.     IF NOT NULL S9            ; If something entered
  1011.        CHDIR S9            ; Do it.
  1012.        SET FLAG(2) ON        ; Save the fact we've done a CHDIR
  1013.        ENDIF
  1014.     GOTO Priv_Prompt        ; And continue
  1015. ; -----------------------------------------------------------------------
  1016. ;    Privileged user: Path tree... awkward... but it works
  1017. ; -----------------------------------------------------------------------
  1018. ;
  1019. PATHLIST:
  1020.     MESS "^M^JPathlist command: "   ; Local console indicator
  1021.     TRAN "^M^JWorking..."           ; May take a moment
  1022.  
  1023.     DOS "TREED >\HOSTTEMP.TXT"      ; To a temp file
  1024.  
  1025.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  1026.     SENDFILE ASCII "\HOSTTEMP.TXT"
  1027.     TRAN "^M^J"                     ; Send a c/r
  1028.  
  1029.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  1030.     GOTO Priv_Prompt        ; And continue
  1031. ; -----------------------------------------------------------------------
  1032. ;    Privileged user: DOS SHELL... Query for a command
  1033. ; -----------------------------------------------------------------------
  1034. ;
  1035. Shell:
  1036.     MESS "^M^JDOS Command: "        ; Local console indicator
  1037.     TRAN "^M^JWarning: this command may be used to invoke ANY COMMAND that"
  1038.     TRAN "^M^JDOS can execute.  If you load a program requiring keyboard  "
  1039.     TRAN "^M^Jentry, you lock yourself out and leave the board unusable."
  1040.     TRAN "^M^J"
  1041.     TRAN "^M^JEnter your command: "
  1042.  
  1043.     GOSUB Read_Comm         ; Read into S9
  1044.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1045.  
  1046.     IF NULL S9            ; If nothing entered
  1047.        GOTO Priv_Prompt        ; User decided better
  1048.        ENDIF
  1049.  
  1050.     IF FIND S9 "FORMAT"             ; Disallow any format commands
  1051.        TRAN "^M^JFormat commands are not allowed..."
  1052.        GOTO Priv_Prompt        ; And continue
  1053.        ENDIF
  1054. ;
  1055. ;    Perform it
  1056. ;
  1057.     TRAN "^M^JWorking..."           ; May take a moment
  1058.  
  1059.     CONCAT S9 ">\HOSTTEMP.TXT"
  1060.     DOS   S9            ; Do it.
  1061.  
  1062.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  1063.     SENDFILE ASCII "\HOSTTEMP.TXT"
  1064.     TRAN "^M^J"                     ; Send a c/r
  1065.  
  1066.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  1067.     GOTO Priv_Prompt        ; And continue
  1068. ; -----------------------------------------------------------------------
  1069. ;    Directory list... awkward... but it works
  1070. ; -----------------------------------------------------------------------
  1071. ;
  1072. Dir:
  1073.     MESS "^M^JDirectory command: "  ; Local console indicator
  1074.     TRAN "^M^JWorking..."           ; May take a moment
  1075.  
  1076.     DOS "DIR >\HOSTTEMP.TXT"        ; To a temp file
  1077.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  1078.     SENDFILE ASCII "\HOSTTEMP.TXT"
  1079.     TRAN "^M^J"                     ; Send a c/r
  1080.  
  1081.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  1082.     GOTO Priv_Prompt        ; And continue
  1083. ; -----------------------------------------------------------------------
  1084. ;    DROPDOS command: Request a password
  1085. ; -----------------------------------------------------------------------
  1086. ;
  1087. DROPDOS:
  1088.     IF NULL S26
  1089.        TRAN "^M^JCommand not recognized... try again"
  1090.        GOTO Priv_Prompt    ; Can't do it
  1091.        ENDIF
  1092. ;
  1093. ;    DROPDOS... Build a batch file
  1094. ;
  1095.     FOPENO "HOSTTEMP.BAT" TEXT
  1096.     IF NOT SUCCESS
  1097.        TRAN "File error - cannot drop to DOS^M^J"
  1098.        GOTO Priv_Prompt
  1099.        ENDIF
  1100.  
  1101.     WRITE "ECHO OFF!"       ; Start the batch file
  1102.     S0 = S26        ; Setup up drop to DOS command
  1103.     PRESERVE S0        ; Make it printable
  1104.     WRITE S0        ; Write the Drop to DOS command
  1105.     WRITE "!"               ; And a terminating cr
  1106.  
  1107.     WRITE S29(0:1)*"!"      ; Change to drive
  1108.     IF NOT NULL S29(2:79) WRITE "CD "*S29(2:79)&"!" ; Rtn to original dir
  1109.     WRITE "COM-AND /q/p/f"  ; Inhibit COM-AND.CMD; take modem as set
  1110.     WRITE "_SCRIPT"&"!"     ; .. rtn to this self-same script
  1111.     WRITE "^Z"
  1112.     FCLOSEO         ; And we're done with it
  1113. ;
  1114. ;    Construct a file to retain our settings
  1115. ;
  1116.     S0 = "OFFOFFOFF"        ; Save flag(1-3) values
  1117.     IF FLAG(1) S0(0:2) = "ON"
  1118.     IF FLAG(2) S0(3:5) = "ON"
  1119.     IF FLAG(3) S0(6:8) = "ON"
  1120.     STORE STRING "HOSTTEMP.STR" ; Used by main-line to signal doorway rtn
  1121. ;
  1122. ;    And drop-to-DOS
  1123. ;
  1124.     CLOG "* Drop-to-DOS"
  1125.     SET TTHRU OFF        ; Disable type through
  1126.     STACK CLEAR        ; Place invocation of the batch file
  1127.     STACK "HOSTTEMP.BAT!"   ; .. into BIOS's area
  1128.     BYE            ; Do it.
  1129. ; -----------------------------------------------------------------------
  1130. ;    Files command: File list, Upload, download or back to main
  1131. ;
  1132. ;    Note: S19 must be retained throughout this submenu...
  1133. ;          It is used to save the current subdir
  1134. ; -----------------------------------------------------------------------
  1135. ;
  1136. File_Command:
  1137.     MESS "^M^JFile prompt: "        ; Local console indicator
  1138.     SUBDIR S19            ; Save current subdir
  1139.     CHDIR S23            ; Set to default subdir
  1140. ;
  1141. ;    Prompt for a command
  1142. ;
  1143. File_Prompt:
  1144.     GOSUB Display_Limit        ; Report amount of time remaining
  1145.     S9 = "^M^JL)ist, S)earch, U)pload, D)ownload, M)ain or E)xit: "
  1146.     S8 = "BBS-FiMe"                 ; Set file name
  1147.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1148. ;
  1149. ;    Keep just the first char entered
  1150. ;
  1151.     GOSUB Read_Comm         ; Read into S9
  1152.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1153.  
  1154.     LJ S9                ; Left justify S9
  1155.     S9 = S9(0:0)            ; Keep just the first char
  1156. ;
  1157. ;    Interpret the command
  1158. ;
  1159.     SWITCH S9            ; Test the entry
  1160.     ;
  1161.     ;    Download command
  1162.     ;
  1163.        CASE "D"                     ; Download
  1164.           GOTO DOWNLOAD
  1165.        ENDCASE
  1166.     ;
  1167.     ;    Upload command
  1168.     ;
  1169.        CASE "U"                     ; Upload
  1170.           GOTO UPLOAD
  1171.        ENDCASE
  1172.     ;
  1173.     ;    List command
  1174.     ;
  1175.        CASE "L"                     ; File list
  1176.           GOTO FILELIST
  1177.        ENDCASE
  1178.     ;
  1179.     ;    Search command
  1180.     ;
  1181.        CASE "S"                     ; Search list
  1182.           GOTO Search
  1183.        ENDCASE
  1184.     ;
  1185.     ;    Main command
  1186.     ;
  1187.        CASE "M"                     ; Go back to main prompt
  1188.           CHDIR S19         ; Reset subdir
  1189.           GOTO Main_Prompt
  1190.        ENDCASE
  1191.     ;
  1192.     ;    Exit command
  1193.     ;
  1194.        CASE "E"                     ; Exit
  1195.           GOTO Logoff        ; Transmit acknowlegement and Exit
  1196.        ENDCASE
  1197.     ENDSWITCH
  1198.  
  1199.     TRAN "Invalid selection - try again^M^J"
  1200.     GOTO FILE_Prompt
  1201. ; -----------------------------------------------------------------------
  1202. ;    Subroutine: Query for a file name - return in S8
  1203. ;    On exit:
  1204. ;       FLAG(0) Returned ON to indicate caller disconn/timedout
  1205. ; -----------------------------------------------------------------------
  1206. ;
  1207. File_Query:
  1208.     MESS "^M^JFname query: "        ; Local console indicator
  1209.     TRAN "^M^JEnter the file name: "
  1210.  
  1211.     GOSUB Read_Comm         ; Read into S9
  1212.     RETURN                ; Return to caller (w/flag(0) set)
  1213. ;
  1214. ; -----------------------------------------------------------------------
  1215. ;    XMODEM Upload (up from caller)
  1216. ;
  1217. ;    Files unqualified by drive:subdir are placed in the default
  1218. ;    DLOAD subdirectory.
  1219. ;
  1220. ;    Note: Qualified names (containing subdir) are permitted
  1221. ;          only if the privilege flag (FLAG(1)) is set.
  1222. ; -----------------------------------------------------------------------
  1223. ;
  1224. UPLOAD:
  1225.     MESS "^M^JUpload from caller "
  1226.  
  1227.     GOSUB File_Query        ; Ask for a file name
  1228.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1229.  
  1230.     IF NULL S9            ; If no file returned
  1231.        GOTO File_Prompt        ; .. start over
  1232.        ENDIF            ; ..
  1233.  
  1234.     IF FIND S9 "\" and NOT FLAG(1)  ; Test for subdir in name and privilege
  1235.        TRAN "^M^JQualified file names are not permitted."
  1236.        GOTO UPLOAD            ; Ask again
  1237.        ENDIF
  1238.  
  1239.     IF ISDLFILE S9            ; If file exists in DL subdir
  1240.        TRAN "^M^JFile already exists"
  1241.        GOTO UPLOAD            ; Ask again
  1242.        ENDIF
  1243. ;
  1244. ;    Prompt for a method
  1245. ;
  1246.     MESS "^M^JUlo Method prompt: "  ; Local console indicator
  1247.     TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, or K)ermit: "
  1248.  
  1249.     S8 = S9             ; Save file name
  1250. ;
  1251. ;    Keep just the first char entered
  1252. ;
  1253.     GOSUB Read_Comm         ; Read into S9
  1254.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1255.  
  1256.     LJ S9                ; Left justify S9
  1257.     S9 = S9(0:0)            ; Keep just the first char
  1258. ;
  1259. ;    Interpret the response
  1260. ;
  1261.     TIME S10 1            ; Save start of upload time
  1262.     SWITCH S9            ; Test the entry
  1263.        CASE "W"
  1264.           TRAN "^M^JBegin your transfer procedure..."
  1265.           GETFILE WXMODEM S8
  1266.        ENDCASE
  1267.        CASE "X"
  1268.           TRAN "^M^JBegin your transfer procedure..."
  1269.           GETFILE XMODEM S8
  1270.        ENDCASE
  1271.        CASE "Y"
  1272.           TRAN "^M^JBegin your transfer procedure..."
  1273.           GETFILE YMODEM S8
  1274.        ENDCASE
  1275.        CASE "Z"
  1276.           TRAN "^M^JBegin your transfer procedure..."
  1277.           GETFILE ZMODEM
  1278.        ENDCASE
  1279.        CASE "K"
  1280.           TRAN "^M^JBegin your transfer procedure..."
  1281.           GETFILE KERMIT        ; FIle name supplied by caller
  1282.        ENDCASE
  1283.        DEFAULT
  1284.           TRAN "^M^JInvalid transfer selection"
  1285.           SET SUCCESS OFF
  1286.           GOTO EOTransfer
  1287.        ENDCASE
  1288.     ENDSWITCH
  1289. ;
  1290. ;    Log the transfer
  1291. ;
  1292.     IF FAILED
  1293.        S9 = "Upload ("*S9(0:0)*"): "*S8&", Failure"
  1294.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  1295.        DELETE S8            ; Delete parial file
  1296.        SET SUCCESS OFF        ; Control msg to console
  1297.        GOTO EOTransfer
  1298.     ELSE
  1299.        S9 = "Upload ("*S9(0:0)*"): "*S8&", Success"
  1300.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  1301.        ENDIF
  1302. ;
  1303. ;    A file uploaded with subdirectory doesn't get logged
  1304. ;
  1305.     IF FIND S8 "\"                  ; Test for subdir in name
  1306.        GOTO File_Prompt        ; Skip logging it
  1307.        ENDIF
  1308. ;
  1309. ;    Convert times to numeric quantities
  1310. ;
  1311.     TIME S11 1            ; Get current time (military fmt)
  1312.     N19 = S11(0:1)*60+S11(3:4)    ; Compute current time since midnight
  1313.     N18 = S10(0:1)*60+S10(3:4)    ; Time of upload since midnight
  1314. ;
  1315. ;    Compute the time remaining and add it to the max
  1316. ;
  1317.     IF GT N18 N19            ; If timeout on the RGET
  1318.        N19 = N19+1440        ; Allow wrap accross midnight
  1319.        ENDIF
  1320.     N0 = N0+(N19-N18)        ; Compute time to upload and add it in
  1321. ;
  1322. ;    At this point, ask for a description for the file
  1323. ;
  1324. Describe:
  1325.     TRAN "^M^JDescription: "        ; Prompt
  1326.     GOSUB Read_Comm         ; Read response
  1327.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1328.  
  1329.     IF NULL S9            ; If nothing entered
  1330.        TRAN "^M^JPlease leave something of a description"
  1331.        GOTO Describe        ; Try again
  1332.        ENDIF
  1333. ;
  1334. ;    Open the file list, and append the file
  1335. ;
  1336.     FOPENO "BBS-File"  TEXT APPEND  ; Open the file to append
  1337.     IF FAILED
  1338.        S9 = "Uload of "*S8&" succeeded, but BBS-FIle open failed"
  1339.        GOSUB Log_Item        ; Log it
  1340.        SET SUCCESS OFF        ; Indicate failure for console
  1341.        GOTO EOTransfer        ; If error, exit
  1342.        ENDIF
  1343. ;
  1344. ;    Build a record for BBS-FIle
  1345. ;
  1346.     DATE S0             ; Get the current date
  1347.     S8 = S8 & "            "        ; Ensure blank padding
  1348.     FSIZE S11 S8            ; Get file size using fname
  1349.     S10 = S8(0:11) * S0(0:7) *" "* S11(0:6) * S9
  1350.     WRITE S10            ; write the record
  1351.     WRITE "!"                       ; Write a delimiter
  1352.  
  1353.     FCLOSEO             ; Close the output file
  1354.     SET SUCCESS ON            ; Indicate success
  1355.     GOTO EOTransfer         ; Report success/failure
  1356. ; -----------------------------------------------------------------------
  1357. ;    XMODEM Download (down to caller)
  1358. ;
  1359. ;    Download occurs from the default drive:subdir unless explicitly
  1360. ;    qualified.
  1361. ;
  1362. ;    Note: Qualified names (containing subdir) are permitted
  1363. ;          only if the privilege flag (FLAG(1)) is set.
  1364. ; -----------------------------------------------------------------------
  1365. ;
  1366. DOWNLOAD:
  1367.     MESS "^M^JDownload to caller "
  1368.  
  1369.     GOSUB File_Query        ; Ask for a file name
  1370.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1371.  
  1372.     IF NULL S9 GOTO File_Prompt    ; If no file returned, start over
  1373.     IF FIND S9 "\"                  ; Test for subdir
  1374.        IF NOT FLAG(1)        ; Test for privilege
  1375.           TRAN "^M^JQualified file names are not permitted."
  1376.           GOTO DOWNLOAD        ; Ask again
  1377.           ENDIF
  1378.        ENDIF
  1379.  
  1380.     IF NOT ISFILE S9        ; If file doesn't exist
  1381.        GOSUB FileTest        ; Look in BBS-File
  1382.        IF FAILED            ; If not found
  1383.           TRAN "^M^JFile doesn't exist"
  1384.           GOTO DOWNLOAD        ; Ask again
  1385.           ENDIF            ; Else S9 contains file name
  1386.        ENDIF
  1387.     S8 = S9             ; Save file name
  1388. ;
  1389. ;    Prompt for a method
  1390. ;
  1391.     MESS "^M^JDlo Method prompt "
  1392.     TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, K)ermit, or A)scii: "
  1393. ;
  1394. ;    Keep just the first char entered
  1395. ;
  1396.     GOSUB Read_Comm         ; Read into S9
  1397.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1398.  
  1399.     LJ S9                ; Left justify S9
  1400.     S9 = S9(0:0)            ; Keep just the first char
  1401. ;
  1402. ;    Interpret the response
  1403. ;
  1404.     SWITCH S9            ; Test the entry
  1405.        CASE "A"
  1406.           TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  1407.           SENDFILE ASCII S8
  1408.        ENDCASE
  1409.        CASE "W"
  1410.           TRAN "^M^JBegin your transfer procedure..."
  1411.           SENDFILE WXMODEM S8
  1412.        ENDCASE
  1413.        CASE "X"
  1414.           TRAN "^M^JBegin your transfer procedure..."
  1415.           SENDFILE XMODEM S8
  1416.        ENDCASE
  1417.        CASE "Y"
  1418.           TRAN "^M^JBegin your transfer procedure..."
  1419.           SENDFILE YMODEM S8
  1420.        ENDCASE
  1421.        CASE "Z"
  1422.           TRAN "^M^JBegin your transfer procedure..."
  1423.           SENDFILE ZMODEM S8
  1424.        ENDCASE
  1425.        CASE "K"
  1426.           TRAN "^M^JBegin your transfer procedure..."
  1427.           SENDFILE KERMIT S8
  1428.        ENDCASE
  1429.        DEFAULT
  1430.           TRAN "^M^JInvalid transfer selection"
  1431.           SET SUCCESS OFF        ; Indicate failure for console
  1432.           GOTO EOTransfer
  1433.        ENDCASE
  1434.     ENDSWITCH
  1435. ;
  1436. ;    Log the download
  1437. ;
  1438.     IF FAILED
  1439.        S9 = "Download ("*S9(0:0)*"): "*S8&", Failure"
  1440.        GOSUB Log_Item    ; Add S9 to BBS-LOG
  1441.        SET SUCCESS OFF
  1442.     ELSE
  1443.        S9 = "Download ("*S9(0:0)*"): "*S8&", Success"
  1444.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  1445.        SET SUCCESS ON
  1446.        ENDIF
  1447. ;
  1448. ;    End of transfer... note result on local console
  1449. ;
  1450. EOTransfer:
  1451.     IF FAILED
  1452.        MESS "^M^JTransfer failed "
  1453.     ELSE
  1454.        MESS "^M^JTransfer OK "
  1455.        ENDIF
  1456.     GOTO File_Prompt
  1457. ; -----------------------------------------------------------------------
  1458. ;    FileTest - take qualification for fname from description
  1459. ;    S8 passes the name to use - returned fully qualified
  1460. ; -----------------------------------------------------------------------
  1461. ;
  1462. FileTest:
  1463.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1464.     IF FAILED            ; IF error opening
  1465.        SET SUCCESS OFF        ; Indicate file dne
  1466.        RETURN            ; Rtn to caller
  1467.        ENDIF
  1468.     LJ S9                ; Left justify
  1469. ;
  1470. ;    Read records from BBS-File
  1471. ;
  1472. FTestLoop:
  1473.     READ S0 80 N19            ; Read a record
  1474.     IF EOF GOTO FTestEnd        ; On end of file, report not found
  1475. ;
  1476. ;    With the exception of comments, test for file availability
  1477. ;
  1478.     IF FIND S0(0:0) "*" GOTO FTestLoop  ; Ignore comments simply
  1479.     IF NOT FIND S0(0:11) S9 GOTO FTestLoop
  1480.     S2 = S0(0:11)            ; Extract File name
  1481.     IF FIND S0(28:28) "^A"          ; Look for ^A in description
  1482.        IF FIND S0(29:79) "^A" N11   ; .. want a pair...
  1483.           S2 = S0(29:29+N11-1)&"\"*S2   ; Use between as subdir
  1484.           ENDIF
  1485.        ENDIF
  1486.     IF NOT ISFILE S2 GOTO FTestLoop ; If file dosn't exist
  1487. ;
  1488. ;    We have a match...
  1489. ;
  1490.     S9 = S2             ; Rtn file name in S9
  1491.     FCLOSEI             ; Close input file
  1492.     SET SUCCESS ON            ; And indicate success
  1493.     RETURN                ; Rtn to caller
  1494. ;
  1495. ;    End of loop
  1496. ;
  1497. FTestEnd:
  1498.     FCLOSEI             ; CLOSE the keys file
  1499.     SET SUCCESS OFF         ; Indicate not found
  1500.     RETURN                ; Rtn to caller
  1501. ; -----------------------------------------------------------------------
  1502. ;    List command - list file directories
  1503. ; -----------------------------------------------------------------------
  1504. ;
  1505. Filelist:
  1506.     N10 = 0             ; Initialize counter (# records)
  1507.  
  1508.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1509.     IF FAILED            ; IF error opening
  1510.        TRAN "^M^JNo files are available at this time^M^J"
  1511.        GOTO File_Prompt        ; And go back to files mainline
  1512.        ENDIF
  1513. ;
  1514. ;    Read records from BBS-File
  1515. ;
  1516. FListLoop:
  1517.     READ S9 80 N19            ; Read a record
  1518.     IF EOF GOTO FListEnd        ; On end of file, report count found
  1519. ;
  1520. ;    With the exception of comments, test for file availability
  1521. ;
  1522.     IF FIND S9(0:0) "*" GOTO FListPrint ; Print comments simply
  1523.     S0 = S9(0:11)                ; Extract File name
  1524.     IF FIND S9(28:28) "^A"              ; Look for ^A in description
  1525.        IF FIND S9(29:79) "^A" N11       ; .. want a pair...
  1526.           S0 = S9(29:29+N11-1)&"\"*S0   ; Use between as subdir
  1527.           S9(28:79) = S9(29+N11+1:79)   ; Remove from description
  1528.           ENDIF
  1529.        ENDIF
  1530.     IF NOT ISFILE S0 GOTO FListLoop     ; If file dosn't exist
  1531.     IF FIND S9(12:12) "*"               ; If not dated...
  1532.        FDATE S2 S0 1            ; .. get date
  1533.        FSIZE S3 S0                ; .. and size
  1534.        S9(12:19) = S2            ; .. and put into record
  1535.        S9(21:27) = S3            ; For display
  1536.        ENDIF
  1537. ;
  1538. ;    If nothing has been displayed yet, do a heading
  1539. ;
  1540.     IF ZERO N10            ; If no recs displayed yet
  1541.        TRAN "^M^JName         Dated    Size    Description ^M^J"
  1542.        TRAN "------------ -------- ------- ----------------------------------------------^M^J"
  1543.        ENDIF
  1544. ;
  1545. ;    Format the record for printing
  1546. ;
  1547.     S9 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
  1548. ;
  1549. ;    And display the record
  1550. ;
  1551. FListPrint:
  1552.     PRESERVE S9            ; Retain !s ^s and `s
  1553.     TRAN S9             ; Display the record
  1554.     TRAN "^M^J"                     ; And a cr/lf
  1555.     N10 = N10+1            ; COunt this one
  1556.     GOTO FListLoop            ; Loop until EOF
  1557. ;
  1558. ;    End of loop
  1559. ;
  1560. FListEnd:
  1561.     FCLOSEI             ; CLOSE the keys file
  1562.     GOTO File_Prompt        ; And loop until EOF
  1563. ; -----------------------------------------------------------------------
  1564. ;    Search command - search file directory
  1565. ; -----------------------------------------------------------------------
  1566. ;
  1567. Search:
  1568.     TRAN "^M^JEnter the search string: "
  1569.     GOSUB Read_Comm         ; Read response
  1570.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1571.  
  1572.     IF NULL S9 GOTO File_Prompt    ; If blank response exit
  1573.     S18 = S9            ; Save search string
  1574. ;
  1575. ;    Open the directory for searching
  1576. ;
  1577.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1578.     IF FAILED            ; IF error opening
  1579.        TRAN "^M^JNo files are available at this time^M^J"
  1580.        GOTO File_Prompt        ; And go back to mainline
  1581.        ENDIF
  1582.     N10 = 0             ; Initialize counter (# records)
  1583. ;
  1584. ;    Read a record
  1585. ;
  1586. Search_Loop:
  1587.     READ S9 80 N19            ; Read a record
  1588.     IF EOF GOTO Search_End        ; On end of file, Skip
  1589. ;
  1590. ;    With the exception of comments, test for file availability
  1591. ;
  1592.     IF FIND S9(0:0) "*" GOTO Search_Loop ; Always skip comments
  1593.     S0 = S9(0:11)            ; Extract File name
  1594.     IF FIND S9(28:28) "^A"              ; Look for ^A in description
  1595.        IF FIND S9(29:79) "^A" N11       ; .. want a pair...
  1596.           S0 = S9(29:29+N11-1)&"\"*S0   ; Use between as subdir
  1597.           S9(28:79) = S9(29+N11+1:79)   ; Remove from description
  1598.           ENDIF
  1599.        ENDIF
  1600.     IF NOT ISFILE S0 GOTO Search_Loop   ; If file dosn't exist
  1601.     IF FIND S9(12:12) "*"               ; If not dated...
  1602.        FDATE S2 S0 1            ; .. get date
  1603.        FSIZE S3 S0                ; .. and size
  1604.        S9(12:19) = S2            ; .. and put into record
  1605.        S9(21:27) = S3            ; For display
  1606.        ENDIF
  1607. ;
  1608. ;    Test for target string in record
  1609. ;
  1610.     IF NOT FIND S9 S18 GOTO Search_Loop
  1611. ;
  1612. ;    If nothing has been displayed yet, do a heading
  1613. ;
  1614.     IF ZERO N10            ; If no recs displayed yet
  1615.        TRAN "^M^JName         Dated    Size    Description ^M^J"
  1616.        TRAN "------------ -------- ------- ----------------------------------------------^M^J"
  1617.        ENDIF
  1618. ;
  1619. ;    Format the record for printing
  1620. ;
  1621.     S0 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
  1622.     PRESERVE S0            ; Retain !s ^s and `s
  1623.     TRAN S0             ; Display the record
  1624.     TRAN "^M^J"                     ; And a cr/lf
  1625.     N10 = N10+1            ; COunt this one
  1626.     GOTO Search_Loop        ; Loop until EOF
  1627. ;
  1628. ;    End of loop
  1629. ;
  1630. Search_End:
  1631.     IF ZERO N10            ; If nothing found...
  1632.        TRAN "^M^JNo matches"        ; Indicate it
  1633.        ENDIF
  1634.  
  1635.     FCLOSEI             ; CLOSE the keys file
  1636.     GOTO File_Prompt        ; And loop until EOF
  1637. ; -----------------------------------------------------------------------
  1638. ;    Leave a comment (branched to - "Main_Prompt")
  1639. ;
  1640. ;    This routine executes out of the defined BBS subdir, no matter
  1641. ;    what subdir a privileged user has selected.  It saves the current
  1642. ;    subdir and restores it upon completion.
  1643. ;
  1644. ;    Note: S19 must be retained throughout this submenu...
  1645. ;          It is used to save the current subdir
  1646. ; -----------------------------------------------------------------------
  1647. ;
  1648. Comment:
  1649.     SUBDIR S19            ; Save current subdir
  1650.     CHDIR S22            ; Reset current subdir
  1651.  
  1652.     MESS "^M^JComment requested "
  1653.     S9 = "Do you wish to leave a comment? (Y/N, cr=n): "
  1654.     S8 = "BBS-NoMe"                 ; Set file name
  1655.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1656.  
  1657.     GOSUB Read_Comm         ; Read a response
  1658.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1659.  
  1660.     FIND S9 "Y"                     ; Look for "Y"
  1661.     IF NOT FOUND            ; IF answer wan't 'Y'
  1662.        TRAN "OK"                    ; Odd character
  1663.        CHDIR S19            ; Reset default subdir
  1664.        GOTO Main_Prompt        ; We're done.
  1665.        ENDIF
  1666. ;
  1667. ;    Open the comments file
  1668. ;
  1669.     FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input
  1670.     IF FAILED            ; if open failed
  1671.        TRAN "Error recording note - please try later^M^J"
  1672.        CHDIR S19            ; Reset default subdir
  1673.        GOTO Main_Prompt        ; GOTO Main_Prompt to caller
  1674.        ENDIF
  1675.  
  1676.     S9 = "*** Note left by "
  1677.     CONCAT S9(17) S1        ; Add User ID
  1678.     DATE S8
  1679.     CONCAT S9(25) S8(0:9)        ; Add date
  1680.     TIME S8 1            ; (military fmt)
  1681.     CONCAT S9(35) S8(0:7)        ; Add time
  1682.     WRITE S9            ; Write header to file     * COM-AND
  1683.     WRITE "!"                       ; Write a record delim   * COM-AND
  1684. ;
  1685. ;    Ask for lines, and write them to the output file
  1686. ;
  1687.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  1688.     TRAN "Enter a line/line(s) of text.  A blank line ends the note.^M^J"
  1689.     GOSUB Copy_Text         ; Note FLAG(0) test below
  1690. ;
  1691. ;    We have a blank line - and the end of a note
  1692. ;
  1693.     WRITE "------------!"           ; Write a delimiter
  1694.     FCLOSEO             ; CLose the file
  1695.     IF FLAG(0) GOTO Exit        ; If COPY_Text rtns flag set, disconn
  1696.     TRAN "Your note has been recorded - thanks^M^J"
  1697. ;
  1698. ;    Log the fact, cleanup and we're done
  1699. ;
  1700.     S9 = "Comment recorded"
  1701.     GOSUB Log_Item            ; Write to BBS-Log
  1702.  
  1703.     CHDIR S19            ; Reset default subdir
  1704.     GOTO Main_Prompt        ; GO for next cmd
  1705. ; -----------------------------------------------------------------------
  1706. ;    Bulletin command: List, and read a specific item
  1707. ;
  1708. ;    The BBS-BULL file is structured:
  1709. ;    0      5        13 14     26
  1710. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1711. ;    ! Number  ! Date    !  ! Fname     ! Subject (40 char)!
  1712. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1713. ;                 ^ Privileged user bulletin flag
  1714. ;
  1715. ;    Note: S19 must be retained throughout this submenu...
  1716. ;          It is used to save the current subdir
  1717. ; -----------------------------------------------------------------------
  1718. ;
  1719. Bull_Command:
  1720.     SUBDIR S19            ; Save current subdir
  1721.     CHDIR S25            ; Switch to Bulletins subdir
  1722. ;
  1723. ;    Restart (perform a list command) at this point
  1724. ;
  1725. BULL_List:
  1726.     MESS "^M^JBulletin list: "      ; Local console indicator
  1727.     N10 = 0             ; Initialize a counter
  1728.  
  1729.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1730.     IF FAILED            ; IF error opening
  1731.        TRAN "^M^JNo bulletins exist^M^J"
  1732.        CHDIR S19            ; Return to default subdir
  1733.        GOTO Main_Prompt        ; And go back to mainline
  1734.        ENDIF
  1735. ;
  1736. ;    Read a record
  1737. ;
  1738. Bull_Loop:
  1739.     READ S9 80 N19            ; Read a record
  1740.     IF EOF GOTO Bull_Prompt     ; Test for end of file
  1741.     IF NOT NULL S9(13:13)        ; Test privilege flag
  1742.        IF NOT FLAG(1) GOTO Bull_Loop; Only display if privileged user
  1743.        ENDIF
  1744. ;
  1745. ;    With the exception of comments, test for file availability
  1746. ;
  1747.     IF FIND S9(0:0) "*" GOTO Bull_Loop ; Skip comments
  1748.  
  1749.     S0 = S9(14:25)            ; Extract File name
  1750.     IF NOT ISFILE S0 GOTO Bull_Loop ; If file dosn't exist
  1751. ;
  1752. ;    If nothing has been displayed yet, do a heading
  1753. ;
  1754.     IF ZERO N10            ; If no recs displayed yet
  1755.        TRAN "^M^JNum   Dated    Subject^M^J"
  1756.        TRAN "----- -------- -------------------------------------------------------------^M^J"
  1757.        ENDIF
  1758. ;
  1759. ;    And display the record
  1760. ;
  1761.     S0 = S9(0:4)*" "*S9(5:12)*" "*S9(26:79)
  1762.     PRESERVE S0            ; Retain !s ^s and `s
  1763.     TRAN S0             ; Display the record
  1764.     TRAN "^M^J"                     ; And a cr/lf
  1765.     N10 = N10+1            ; COunt this one
  1766.     GOTO Bull_Loop            ; Loop until EOF
  1767. ;
  1768. ;    End of loop:  prompt for a bulletin number
  1769. ;
  1770. Bull_Prompt:
  1771.     FCLOSEI             ; CLose the input file
  1772.     GOSUB Display_Limit        ; Report amount of time remaining
  1773.     S9 = "^M^JL)ist, M)ain, E)xit, or a bulletin number: "
  1774.     S8 = "BBS-BuMe"                 ; Set file name
  1775.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1776. ;
  1777. ;    Read a response
  1778. ;
  1779.     GOSUB Read_Comm         ; Read into S9
  1780.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn and restart
  1781. ;
  1782. ;    Test for alpha commands
  1783. ;
  1784.     LJ S9                ; Left justify S9
  1785.     IF FIND S9(0:0) "L"             ; If command was List
  1786.        GOTO Bull_List        ; Perform the list again
  1787.        ENDIF
  1788.  
  1789.     IF FIND S9(0:0) "M"             ; If command was Main
  1790.        CHDIR S19            ; Return to default subdir
  1791.        GOTO Main_Prompt        ; Go back to main
  1792.        ENDIF
  1793.  
  1794.     IF FIND S9(0:0) "E"             ; If command was Exit
  1795.        GOTO Logoff            ; Transmit acknowlegement and Exit
  1796.        ENDIF
  1797. ;
  1798. ;    We're going to scan the keys file for the input
  1799. ;
  1800.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1801.     IF FAILED            ; IF error opening
  1802.        TRAN "^M^JNo bulletins available^M^J"
  1803.        CHDIR S19            ; Return to default subdir
  1804.        GOTO Main_Prompt        ; And go back to mainline
  1805.        ENDIF
  1806.     S0 = S9             ; Save response in S0
  1807. ;
  1808. ;    Read a record from BBS-Bull
  1809. ;
  1810. Bull_Scan:
  1811.     READ S9 80 N19            ; Read a record
  1812.     IF EOF                ; Test for end of file
  1813.        TRAN "^M^JNo such bulletin!! ^M^J"
  1814.        FCLOSEI            ; CLose input file
  1815.        GOTO Bull_Prompt        ; Select one specific
  1816.        ENDIF
  1817.  
  1818.     IF FIND S9(0:0) "*" GOTO Bull_Scan; Throw away comments
  1819.  
  1820.     IF NOT NULL S9(13:13)        ; Test privilege flag
  1821.        IF NOT FLAG(1) GOTO Bull_Scan; Only display if privileged user
  1822.        ENDIF
  1823. ;
  1824. ;    Test for file availability
  1825. ;
  1826.     S8 = S9(14:25)            ; Extract File name
  1827.     IF NOT ISFILE S8 GOTO Bull_Scan ; If file dosn't exist
  1828. ;
  1829. ;    Test the record number field against the given
  1830. ;
  1831.     S9 = S9(0:4)            ; Extract just the number
  1832.     LJ S9                ; Justify the field in S9; S0 already so
  1833.     SWITCH S9            ; Test using the given #
  1834.        CASE S0(0:4)         ; .. against the rec number field
  1835.           GOTO Bull_Read        ; Match - go read it
  1836.        ENDCASE
  1837.     ENDSWITCH
  1838.     GOTO Bull_Scan            ; Loop until EOF
  1839. ;
  1840. ;    Read a single bulletin - the name is in S8
  1841. ;
  1842. Bull_Read:
  1843.     FCLOSEI             ; Close the mail keys file
  1844.     MESS "^M^JReading bulletin: "*S8; Local console indicator
  1845.  
  1846.     S9 = "^M^JError opening bulletin file" ; Error msg just in case
  1847.     GOSUB Disp_File         ; Display the file
  1848. ;
  1849. ;    Log the fact
  1850. ;
  1851.     S9 = "Bulletin "*S8&" read"
  1852.     GOSUB Log_Item            ; Write to BBS-Log
  1853.     GOTO Bull_Prompt        ; And loop until EOF
  1854. ; -----------------------------------------------------------------------
  1855. ;    Mail command: Read, write or back to main
  1856. ;
  1857. ;    Note: S19 must be retained throughout this submenu...
  1858. ;          It is used to save the current subdir
  1859. ; -----------------------------------------------------------------------
  1860. ;
  1861. Mail_Command:
  1862.     MESS "^M^JMail prompt: "        ; Local console indicator
  1863.     SUBDIR S19            ; Save current default
  1864.     CHDIR S24            ; Set to Messages subdir
  1865. ;
  1866. ;    Prompt for a submenu command
  1867. ;
  1868. Mail_Prompt:
  1869.     GOSUB Display_Limit        ; Report amount of time remaining
  1870.     S9 = "^M^JS)can, L)ist, N)ew, A)ll, W)rite, M)ain or E)xit: "
  1871.     S8 = "BBS-MeMe"                 ; Set file name
  1872.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1873. ;
  1874. ;    Keep just the first char entered
  1875. ;
  1876.     GOSUB Read_Comm         ; Read into S9
  1877.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1878.  
  1879.     LJ S9                ; Left justify S9
  1880.     S9 = S9(0:0)            ; Keep just the first char
  1881. ;
  1882. ;    Interpret the command
  1883. ;
  1884.     SWITCH S9            ; Test the entry
  1885.     ;
  1886.     ;    Read-new command
  1887.     ;
  1888.        CASE "N"                     ; New-Read
  1889.           GOTO Read_New
  1890.        ENDCASE
  1891.     ;
  1892.     ;    Read command
  1893.     ;
  1894.        CASE "A"                     ; All-Read
  1895.           GOTO Read_All
  1896.        ENDCASE
  1897.     ;
  1898.     ;    Write command
  1899.     ;
  1900.        CASE "W"                     ; Write
  1901.           GOTO Write_msg
  1902.        ENDCASE
  1903.     ;
  1904.     ;    Scan command
  1905.     ;
  1906.        CASE "S"                     ; Scan
  1907.           GOTO Scan_Msg
  1908.        ENDCASE
  1909.     ;
  1910.     ;    List command
  1911.     ;
  1912.        CASE "L"                     ; Scan
  1913.           GOTO List_Msg
  1914.        ENDCASE
  1915.     ;
  1916.     ;    Main command
  1917.     ;
  1918.        CASE "M"                     ; Go back to main prompt
  1919.           CHDIR S19         ; Reset subdir
  1920.           GOTO Main_Prompt
  1921.        ENDCASE
  1922.     ;
  1923.     ;    Exit command
  1924.     ;
  1925.        CASE "E"                     ; Exit
  1926.           GOTO Logoff        ; Transmit acknowlegement and Exit
  1927.        ENDCASE
  1928.     ENDSWITCH
  1929.  
  1930.     TRAN "Invalid selection - try again^M^J"
  1931.     GOTO Mail_Prompt
  1932. ; -----------------------------------------------------------------------
  1933. ;    Scan command: Scan for files 'to' the current user
  1934. ;
  1935. ;    The MAILKEY file is structured:
  1936. ;    0      8        16 17     25       38
  1937. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1938. ;    ! To ID   ! From ID !  ! Date     ! Fname   ! Subject (40 char)!
  1939. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1940. ;                 ^Privacy flag = P
  1941. ; -----------------------------------------------------------------------
  1942. ;
  1943. Scan_Msg:
  1944.     N10 = 0             ; Initialize counter (# records)
  1945.     N11 = 0             ; Initialize counter (# to current ID)
  1946.  
  1947.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1948.     IF FAILED GOTO Scan_Rpt     ; IF error opening, Use zero cnt
  1949.     TRAN "^M^JWorking..."           ; May take a moment
  1950. ;
  1951. ;    Read records from BBS_Mail
  1952. ;
  1953. Scan_Loop:
  1954.     READ S9 80 N19            ; Read a record
  1955.     IF EOF GOTO Scan_Rpt        ; On end of file, report count found
  1956.  
  1957.     S0 = S9(0:7)            ; Look at 'to ID' field
  1958.     SWITCH S0            ; Test for our ID
  1959.        CASE S1            ; .. in the record
  1960.           S0 = S9(25:37)        ; Extract File name
  1961.           IF ISFILE S0 INC N11      ; If file exists, count it
  1962.        ENDCASE
  1963.     ENDSWITCH
  1964.  
  1965.     INC N10             ; Count the read
  1966.     N12 = N10/10*10         ; Every 10th record
  1967.     IF EQ N10 N12            ; .. or so
  1968.        TRAN "."                     ; .. indicate we didn't die
  1969.        ENDIF
  1970.     GOTO Scan_Loop            ; Loop until EOF
  1971. ;
  1972. ;    Report the count found
  1973. ;
  1974. Scan_Rpt:
  1975.     IF ZERO N11            ; If no files found
  1976.        TRAN "^M^JYou have no messages waiting"
  1977.     ELSE
  1978.        STRFMT S0 "^M^JYou have %d message(s) waiting." N11
  1979.        TRAN S0            ; Transmit the text
  1980.        ENDIF
  1981.  
  1982.     FCLOSEI             ; CLOSE the keys file
  1983.     GOTO Mail_Prompt        ; And loop until EOF
  1984. ; -----------------------------------------------------------------------
  1985. ;    Mail List command: List files available to be read.
  1986. ; -----------------------------------------------------------------------
  1987. ;
  1988. List_Msg:
  1989.     N10 = 0             ; Initialize counter (# records)
  1990.  
  1991.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1992.     IF FAILED            ; IF error opening
  1993.        TRAN "^M^JNo mail exists - why not write something?^M^J"
  1994.        GOTO Mail_Prompt        ; And go back to mainline
  1995.        ENDIF
  1996. ;
  1997. ;    Read a record from BBS-Mail
  1998. ;
  1999. List_Loop:
  2000.     READ S9 80 N19            ; Read a record
  2001.     IF EOF GOTO List_End        ; On end of file, report count found
  2002.  
  2003.     S0 = S9(0:7)            ; Look at 'to ID' field
  2004.     SWITCH S0            ; Test for our ID
  2005.        CASE S1            ; .. in the record
  2006.        ENDCASE            ; OK if addressed to us
  2007.        DEFAULT            ; If not our ID, test privacy
  2008.          IF FIND S9(16:16) "P"      ; Test privacy flag
  2009.         IF NOT STRCMP S9(8:15) S1 ; If we didn't write it
  2010.            GOTO List_Loop    ; Ignore private messages
  2011.            ENDIF
  2012.         ENDIF
  2013.        ENDCASE
  2014.     ENDSWITCH
  2015.  
  2016.     S0 = S9(25:37)            ; Extract File name
  2017.     IF NOT ISFILE S0 GOTO List_Loop ; If file dosn't exist
  2018. ;
  2019. ;    If nothing has been displayed yet, do a heading
  2020. ;
  2021.     IF ZERO N10            ; If no recs displayed yet
  2022.        TRAN "^M^JTo       From     Date     Subject^M^J"
  2023.        TRAN "-------- -------- -------- -------------------------------------------------^M^J"
  2024.        ENDIF
  2025. ;
  2026. ;    And display the record
  2027. ;
  2028.     S0 = S9(0:7)*" "*S9(8:15)*" "*S9(17:24)*" "*S9(38:79)
  2029.     PRESERVE S0            ; Retain !s ^s and `s
  2030.     TRAN S0             ; Display the record
  2031.     TRAN "^M^J"                     ; And a cr/lf
  2032.     N10 = N10+1            ; COunt this one
  2033.     GOTO List_Loop            ; Loop until EOF
  2034. ;
  2035. ;    End of loop
  2036. ;
  2037. List_End:
  2038.     FCLOSEI             ; CLOSE the keys file
  2039.     GOTO Mail_Prompt        ; And loop until EOF
  2040. ; -----------------------------------------------------------------------
  2041. ;    Read NEW command: Read NEW mail files 'to' the current user
  2042. ;    Setup S7 limiting date
  2043. ; -----------------------------------------------------------------------
  2044. ;
  2045. Read_New:
  2046.     S7 = "        "                 ; Make earliest possible date
  2047.     IF NOT ISFILE S1&".NEW" GOTO Read_Msg
  2048.     FOPENI S1&".NEW" TEXT           ; Open ID.NEW file
  2049.     IF FAILED GOTO Read_Msg     ; Skip on error
  2050.     READ S7 8 N19            ; Read oldest date read
  2051.     FCLOSEI             ; Close file
  2052.     GOTO Read_Msg            ; And read using this date
  2053. ; -----------------------------------------------------------------------
  2054. ;    Read ALL command: Read ALL mail files 'to' the current user
  2055. ;    Setup S7 limiting date
  2056. ; -----------------------------------------------------------------------
  2057. ;
  2058. Read_All:
  2059.     S7 = "        "                 ; Make earliest possible date
  2060.     GOTO Read_Msg            ; And read using this date
  2061. ; -----------------------------------------------------------------------
  2062. ;    Test two dates, one in S0 and one in S2  (each fmttd mm/dd/yy)
  2063. ;    N10 returns -1 if S0 date < S2 date
  2064. ;             0 if S0 date = S2 date
  2065. ;            +1 if S0 date > S2 date
  2066. ; -----------------------------------------------------------------------
  2067. ;
  2068. DateTest:
  2069.     IF NOT NUMERIC S2(0) or NOT NUMERIC S2(3) or NOT NUMERIC S2(6)
  2070.        N10 = 0            ; Fake they're equal
  2071.        RETURN            ; .. and done
  2072.        ENDIF
  2073.  
  2074.     IF NOT NUMERIC S0(0) or NOT NUMERIC S0(3) or NOT NUMERIC S0(6)
  2075.        N10 = 0            ; Fake they're equal
  2076.        RETURN            ; .. and done
  2077.        ENDIF
  2078.  
  2079.     IF S0(6:7) EQ S2(6:7)        ; If recordyear = limityear
  2080.        N10 = (S0(0:1)*100+S0(3:4)) - (S2(0:1)*100+S2(3:4))
  2081.        IF N10 LT 0            ; S0 < S2
  2082.           N10 = -1            ; Return S0 < S2
  2083.        ELSE
  2084.           IF N10 GT 0        ; S0 > S2
  2085.          N10 = 1        ; Return S0 > S2
  2086.           ELSE
  2087.          N10 = 0        ; Return S0 = S2
  2088.          ENDIF
  2089.           ENDIF
  2090.        RETURN            ; And we're done here
  2091.        ENDIF
  2092.  
  2093.     N10 = S0(6:7)+1900        ; Extract S0 year, dft 1900 century
  2094.     N11 = S2(6:7)+1900        ; Extract S2 year, dft 1900 century
  2095.     IF S0(6:7) LT 80 N10 = N10+100    ; 00-79 -> 2000 century
  2096.     IF S2(6:7) LT 80 N11 = N10+100    ; 00-79 -> 2000 century
  2097.  
  2098.     IF N10 LT N11            ; S0 < S2
  2099.        N10 = -1            ; Return S0 < S2
  2100.     ELSE
  2101.        IF N10 GT N11        ; S0 > S2
  2102.           N10 = 1            ; Return S0 > S2
  2103.        ELSE
  2104.           N10 = 0            ; Return S0 = S2
  2105.           ENDIF
  2106.        ENDIF
  2107.     RETURN
  2108. ; -----------------------------------------------------------------------
  2109. ;    Read command: Read mail files 'to' the current user
  2110. ;    S7 passes the date on/after which to read (formatted yymmdd)
  2111. ;    S2 will be used to keep the date of the last record read
  2112. ;    S3 will be used to keep latest date read
  2113. ;    S4 will be used to keep the sender ID
  2114. ;    S5 will be used to keep the subject text
  2115. ; -----------------------------------------------------------------------
  2116. ;
  2117. Read_Msg:
  2118.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  2119.     IF FAILED            ; IF error opening
  2120.        TRAN "^M^JNo mail exists - why not write something?^M^J"
  2121.        GOTO Mail_Prompt        ; And continue
  2122.        ENDIF
  2123.     S3 = "        "                 ; Date of oldest note read
  2124. ;
  2125. ;    Read a line from BBS-Mail
  2126. ;
  2127. Read_Loop:
  2128.     READ S9 80 N19            ; Read a record
  2129.     IF EOF GOTO Read_End        ; On end of file, exit
  2130. ;
  2131. ;    Test the date of the item against the passed limiting date
  2132. ;    .. if either contain non-alpha, skip this step
  2133. ;
  2134.     S2 = S9(17:24)            ; Extract date from record
  2135.     S0 = S7             ; Setup limiting date for compare
  2136.     GOSUB DateTest            ; Compare date in S0 to date in S7
  2137.     IF N10 GT 0 GOTO Read_Loop    ; Skip if limitdate > recorddate
  2138. ;
  2139. ;    Test the ID from the record
  2140. ;
  2141.     S0 = S9(0:7)            ; Look at 'to ID' field
  2142.     SWITCH S0            ; Test ID from the record
  2143.     ;
  2144.     ;    Test for mail to current caller
  2145.     ;
  2146.        CASE S1            ; Against our own ID
  2147.           SET FLAG(9) ON        ; Flag for delete
  2148.        ENDCASE
  2149.     ;
  2150.     ;    Not to current caller - test sender/privacy
  2151.     ;
  2152.        DEFAULT            ; If not our ID, test privacy
  2153.           SET FLAG(9) OFF        ; Flag no delete
  2154.           IF STRCMP S9(8:15) S1 SET FLAG(9) ON ; If we wrote it
  2155.           IF FIND S9(16:16) "P" and NOT FLAG(9)
  2156.          GOTO Read_Loop     ; So.. ignore private messages
  2157.          ENDIF
  2158.        ENDCASE
  2159.     ENDSWITCH
  2160. ;
  2161. ;    We'll read the message
  2162. ;
  2163.     S0 = S9(25:37)            ; Extract File name
  2164.     IF NOT ISFILE S0 GOTO Read_Loop ; If file dosn't exist
  2165. ;
  2166. ;    Save a few values for reply...
  2167. ;
  2168.     S4 = S9(8:15)            ; Setup from-ID for later
  2169.     S5 = S9(38:79)            ; Save subject for later too
  2170. ;
  2171. ;    Display the current file
  2172. ;
  2173.     S8 = S0             ; Set-up file name
  2174.     S9 = "^M^JError opening mailfile"
  2175.     GOSUB Disp_File         ; Display the file
  2176. ;
  2177. ;    Save the date of the record read (S2 contains record date)
  2178. ;
  2179.     S0 = S3             ; Setup oldest date read
  2180.     GOSUB DateTest            ; Compare the two dates
  2181.     IF NULL S3 or N10 LT 0 S3 = S2    ; If oldestdate < recorddate, save new oldest
  2182. ;
  2183. ;    Prompt for next action
  2184. ;
  2185. Read_Disposition:
  2186.     IF FLAG(9)            ; If delete is possible
  2187.        TRAN "^M^JD)elete, R)eply, Q)uit (cr=continue): "
  2188.     ELSE                ; Delete not possible
  2189.        TRAN "^M^JR)eply, Q)uit (cr=continue): "
  2190.        ENDIF
  2191.     GOSUB Read_Comm         ; Read into S9
  2192.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  2193.  
  2194.     LJ S9                ; Left justify S9
  2195.     S9 = S9(0:0)            ; Keep just the first char
  2196.     IF NULL S9 S9 = "c"             ; Fake 'continue'
  2197. ;
  2198. ;    Interpret the command
  2199. ;
  2200.     SWITCH S9            ; Test the entry
  2201.     ;
  2202.     ;    Delete command
  2203.     ;
  2204.        CASE "D"                     ; Delete
  2205.         IF FLAG(9)        ; If it was ours
  2206.            DELETE S8        ; Delete file named in S8
  2207.            TRAN "Message deleted^M^J"; Indicate its done
  2208.         ELSE
  2209.            TRAN "You may not delete this note^M^J"
  2210.            ENDIF
  2211.        ENDCASE
  2212.     ;
  2213.     ;    Reply command
  2214.     ;
  2215.        CASE "R"                     ; All-Read
  2216.           S10 = S4            ; Reply To-ID is current note from-id
  2217.           S11 = S5            ; Default reply subj text
  2218.           IF NOT STRCMP S5(0:9) "Reply to: " S11 = "Reply to: "*S5
  2219.           GOSUB Reply        ; COmpose the reply
  2220.           IF FLAG(0) GOTO Exit    ; Exit on disconn
  2221.        ENDCASE
  2222.     ;
  2223.     ;    Continue command
  2224.     ;
  2225.        CASE "C"                     ; Continue
  2226.           GOTO Read_Loop
  2227.        ENDCASE
  2228.     ;
  2229.     ;    Quit command
  2230.     ;
  2231.        CASE "Q"                     ; Quit
  2232.           GOTO Read_End
  2233.        ENDCASE
  2234.     ;
  2235.     ;    Unrecognized command
  2236.     ;
  2237.        DEFAULT            ; Anything else
  2238.           TRAN "^M^JUnrecognized command - please try again^M^J"
  2239.        ENDCASE
  2240.     ENDSWITCH
  2241.     GOTO Read_Disposition
  2242. ;
  2243. ;    End of read... close input file, and we're done
  2244. ;
  2245. Read_End:
  2246.     FCLOSEI             ; Close the mail keys file
  2247.     IF NOT NULL S3            ; If we read something
  2248.        FOPENO S1&".NEW" TEXT        ; Open ID.NEW file
  2249.        IF FAILED GOTO Mail_Prompt    ; Skip on error
  2250.        WRITE S3*"!"                 ; Write saved date
  2251.        FCLOSEO            ; Close file
  2252.        ENDIF
  2253.     GOTO Mail_Prompt        ; And loop until EOF
  2254. ; -----------------------------------------------------------------------
  2255. ;    Write command - write mail
  2256. ; -----------------------------------------------------------------------
  2257. ;
  2258. Write_Msg:
  2259.     GOSUB Compose            ; Invoke compose a note
  2260.     IF FLAG(0) GOTO Exit        ; Exit on disconn
  2261.     GOTO Mail_Prompt        ; GO for next cmd
  2262. ; -----------------------------------------------------------------------
  2263. ;    Write a mail note - this is a subroutine, as it is called by both
  2264. ;    Read-mail (reply) and Write-Mail.  Note:
  2265. ;    S3 and S7 must be preserved for Read_Msg...
  2266. ;    The caller must test FLAG(0) for disconn...
  2267. ;    An existing FOPENI must be preserved
  2268. ; -----------------------------------------------------------------------
  2269. ;    The entry point 'Reply' requires that S10 contain the TO ID and
  2270. ;    S11 contain the subject line
  2271. ; -----------------------------------------------------------------------
  2272. ;
  2273. Compose:
  2274.     TRAN "To:  ^H"                  ; Prompt for ID
  2275.     GOSUB Read_Comm         ; Read a response
  2276.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2277.  
  2278.     LJ S9                ; Left justify ID
  2279.     IF NULL S9 RETURN        ; If blank entry - exit here
  2280.     S10 = S9(0:7)            ; Save TO ID
  2281.     UPPER S10            ; Force it upper case
  2282. ;
  2283. ;    Prompt for a subject
  2284. ;
  2285.     TRAN "Subject:  ^H"             ; Prompt for subject
  2286.     GOSUB Read_Comm         ; Read a response
  2287.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2288.     S11 = S9            ; Save returned subject
  2289.     PRESERVE S11            ; Retain !s ^s and `s
  2290. ;
  2291. ;    Open a temporary file
  2292. ;
  2293. Reply:
  2294.     FOPENO "\HOSTTEMP.TXT" TEXT     ; OPEN file for output
  2295.     IF FAILED            ; if open failed
  2296.        TRAN "Error opening file - please try later^M^J"
  2297.        RETURN            ; Back to submenu
  2298.        ENDIF
  2299. ;
  2300. ;    Place a header
  2301. ;
  2302.     S9 = "To:    "                  ; Set Sender ID
  2303.     CONCAT S9(7) S10        ; ..
  2304.     WRITE S9            ; Write header to file     * COM-AND
  2305.     WRITE "!"                       ; Write a record delim   * COM-AND
  2306.  
  2307.     S9 = "From: "                   ; Set Sender ID
  2308.     CONCAT S9(7) S1         ; ..
  2309.     WRITE S9            ; Write header to file     * COM-AND
  2310.     WRITE "!"                       ; Write a record delim   * COM-AND
  2311.  
  2312.     S9 = "Date: "                   ; Set date and time
  2313.     DATE S12
  2314.     CONCAT S9(7) S12        ; Add date
  2315.     TIME S8 1            ; (military fmt)
  2316.     CONCAT S9(17) S8        ; Add time
  2317.     WRITE S9            ; Write header to file     * COM-AND
  2318.     WRITE "!"                       ; Write a record delim   * COM-AND
  2319.  
  2320.     S9 = "Subject: "                ; Set subject
  2321.     CONCAT S9(9)  S11        ; ..
  2322.     WRITE S9            ; Write header to file     * COM-AND
  2323.     WRITE "!"                       ; Write a record delim   * COM-AND
  2324.     WRITE "!"                       ; Write a text delim     * COM-AND
  2325. ;
  2326. ;    Ask for lines, and write them to the output file
  2327. ;
  2328.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  2329.     TRAN "Enter a line/line(s) of text.  A blank line ends the text.^M^J"
  2330.     GOSUB Copy_Text         ; Note FLAG(0) test below
  2331.     FCLOSEO             ; Close the file
  2332.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2333. ;
  2334. ;    Ask if the file is to be saved
  2335. ;
  2336.     TRAN "Save? (Y/N, cr=y):  ^H"   ; Ask if its to be saved
  2337.     GOSUB Read_Comm         ; Read a response
  2338.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2339.  
  2340.     IF FIND S9 "N" RETURN           ; Test for "N"
  2341. ;
  2342. ;    Now - scan for the last used file name
  2343. ;
  2344.     TRAN "^M^JScanning for free slot"
  2345.     N10 = 0             ; Set default extension we'll use
  2346.     S0 = S10(0:7)            ; Look at 'to ID' field
  2347. ;
  2348. ;    Look for a free file name
  2349. ;
  2350.     WHILE ISFILE S0&"."&N10         ; Find unused note #
  2351.           INC N10            ; Bump ptr
  2352.           IF N10 GT 999        ; If max msgs reached...
  2353.          TRAN "^M^JToo many notes left undeleted - cannot save^M^J"
  2354.          RETURN         ; Back to caller
  2355.          ENDIF
  2356.           ENDWHILE            ; Loop until match
  2357. ;
  2358. ;    We have found the first free file name
  2359. ;
  2360.     TRAN "^M^JPrivate? (Y/N, cr=n): "; Ask if its to a private msg
  2361.     GOSUB Read_Comm         ; Read a response
  2362.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2363.  
  2364.     S13 = " "                       ; Set privacy flag
  2365.     IF FIND S9 "Y" S13 = "P"        ; Test for "Y" - set flag val
  2366.  
  2367.     S0 = S0&"."&N10                 ; Make a new file name
  2368.     S9 = "COPY \HOSTTEMP.TXT " * S0 ; Make a copy command
  2369.     DOS S9                ; Cannot do own copy (FOPENI in use)
  2370.  
  2371.     FOPENO "BBS-Mail" TEXT APPEND   ; Open the keys file for append
  2372.     WRITE S10 8            ; Write the 'TO ID'
  2373.     WRITE S1  8            ; Write the from ID
  2374.     WRITE S13 1            ; Write privacy flag
  2375.     WRITE S12 8            ; Write date
  2376.     WRITE S0  13            ; Write file name
  2377.     WRITE S11 40            ; Write the subject
  2378.     WRITE "!"                       ; And a delimiter
  2379.     FCLOSEO             ; ANd close the keys file
  2380.     RETURN                ; GO for next cmd
  2381. ; -----------------------------------------------------------------------
  2382. ;    Registration (Exit must be performed after)
  2383. ;
  2384. ;    Upon return: FLAG(0) ON -> Caller disconnected
  2385. ; -----------------------------------------------------------------------
  2386. ;
  2387. Register:
  2388.     MESS "^M^JRegistration requested "
  2389.     S9 = "Do you wish to register? (Y/N, cr=y): "
  2390.     S8 = "BBS-ReMe"                 ; Set file name
  2391.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  2392.  
  2393.     GOSUB Read_Comm         ; Read a response
  2394.     IF FLAG(0)            ; If error
  2395.        S9 = "Registration aborted - disconn"
  2396.        GOSUB Log_Item        ; Log the fact
  2397.        RETURN            ; SImply return
  2398.        ENDIF
  2399.  
  2400.     IF FIND S9 "N"                  ; IF answer wasn't 'n'
  2401.        S9 = "Registration declined by caller"
  2402.        GOSUB Log_Item        ; Log the fact
  2403.        TRAN "OK - bye^M^J"          ; Say g'night Gracie
  2404.        RETURN            ; We're done.
  2405.        ENDIF
  2406. ;
  2407. ;    Ask for a name/address/csz phone and ID/Password
  2408. ;
  2409.     TRAN "Enter your full name: "
  2410.     GOSUB Read_Comm         ; Read a response
  2411.     IF FLAG(0) RETURN        ; If error
  2412.     S18 = S9            ; Save return
  2413.  
  2414.     TRAN "Enter your street address: "
  2415.     GOSUB Read_Comm         ; Read a response
  2416.     IF FLAG(0) RETURN        ; If error
  2417.     S17 = S9            ; Save return
  2418.  
  2419.     TRAN "Enter your city/state and zip: "
  2420.     GOSUB Read_Comm         ; Read a response
  2421.     IF FLAG(0) RETURN        ; If error
  2422.     S16 = S9            ; Save return
  2423.  
  2424.     TRAN "Enter a area code and phone number where^M^J"
  2425.     TRAN "you may be reached:  "
  2426.     GOSUB Read_Comm         ; Read a response
  2427.     IF FLAG(0) RETURN        ; If error
  2428.     S15 = S9            ; Save return
  2429. ;
  2430. ;    Request an ID
  2431. ;
  2432. Reg_ID:
  2433.     TRAN "Enter the ID (1-8 chars) you wish to use: "
  2434.     GOSUB Read_Comm         ; Read a response
  2435.     IF FLAG(0) RETURN        ; If error
  2436.  
  2437.     IF FIND S9(0:7) "."
  2438.        TRAN "ID may not contain '.'s^M^J"
  2439.        GOTO Reg_ID
  2440.        ENDIF
  2441.     IF FIND S9(0:7) ","
  2442.        TRAN "ID may not contain ','s^M^J"
  2443.        GOTO Reg_ID
  2444.        ENDIF
  2445.     IF FIND S9(0:7) "\"
  2446.        TRAN "ID may not contain '\'s^M^J"
  2447.        GOTO Reg_ID
  2448.        ENDIF
  2449.     IF FIND S9(0:7) "/"
  2450.        TRAN "ID may not contain '/'s^M^J"
  2451.        GOTO Reg_ID
  2452.        ENDIF
  2453.     S14 = S9(0:7)            ; Save return
  2454. ;
  2455. ;    Request a password
  2456. ;
  2457. Reg_Pass:
  2458.     TRAN "Enter the password (1-8 chars) you wish to use: "
  2459.     GOSUB Read_Comm         ; Read a response
  2460.     IF FLAG(0) RETURN        ; If error
  2461.  
  2462.     IF NULL S9(0:7)         ; Test for blank entered
  2463.        TRAN "You must have a password^M^J"
  2464.        GOTO Reg_Pass
  2465.        ENDIF
  2466.     S14 = S14 & ";" &S9(0:7)        ; Concatenate PASSWORD to ID
  2467. ;
  2468. ;    Repeat for validity:
  2469. ;
  2470.     TRAN "^M^JRepeating your entry...^M^J"
  2471.     TRAN S18            ; Transmit name
  2472.     TRAN "^M^J"
  2473.     TRAN S17            ; Transmit Street address
  2474.     TRAN "^M^J"
  2475.     TRAN S16            ; Transmit CSZ
  2476.     TRAN "^M^J"
  2477.     TRAN S15            ; Transmit Phone
  2478.     TRAN "^M^J"
  2479.     TRAN S14            ; Transmit ID/password
  2480.  
  2481.     TRAN "^M^JIs this correct? (Y/N, cr=n): "
  2482.     GOSUB Read_Comm         ; Read a response
  2483.     IF FLAG(0) RETURN        ; If error
  2484.  
  2485.     FIND S9 "Y"                     ; Look for "Y"
  2486.     IF NOT FOUND GOTO Register    ; IF answer wan't 'Y', try again
  2487. ;
  2488. ;    Open the comments file
  2489. ;
  2490.     FOPENO "BBS-Note" TEXT APPEND   ; OPEN file for input
  2491.     IF FAILED            ; if open failed
  2492.        TRAN "Error recording registration - please call back^M^J"
  2493.        RETURN            ; Return to caller
  2494.        ENDIF
  2495.  
  2496.     S9 = "*** Registration requested: "
  2497.     DATE S1
  2498.     CONCAT S9(27) S1        ; S1 would be ID anyway
  2499.     TIME S1 1            ; (military fmt)
  2500.     CONCAT S9(38) S1
  2501.     WRITE S9            ; Write a record     * COM-AND
  2502.     WRITE "!"                       ; Write a record delim   * COM-AND
  2503.  
  2504.     WRITE S18 80            ; Write a record     * COM-AND
  2505.     WRITE "!"                       ; Write a record delim   * COM-AND
  2506.     WRITE S17 80            ; Write a record     * COM-AND
  2507.     WRITE "!"                       ; Write a record delim   * COM-AND
  2508.     WRITE S16 80            ; Write a record     * COM-AND
  2509.     WRITE "!"                       ; Write a record delim   * COM-AND
  2510.     WRITE S15 80            ; Write a record     * COM-AND
  2511.     WRITE "!"                       ; Write a record delim   * COM-AND
  2512.     WRITE S14 80            ; Write a record     * COM-AND
  2513.     WRITE "!"                       ; Write a record delim   * COM-AND
  2514.     WRITE "------------!"           ; Write a delimiter
  2515. ;
  2516. ;    Log the fact
  2517. ;
  2518.     S9 = "Registration requested"
  2519.     GOSUB Log_Item            ; Write to BBS-Log
  2520. ;
  2521. ;    We have a successful record
  2522. ;
  2523.     TRAN "Your request will be processed by the SYSOP^M^J"
  2524.     TRAN "Thanks for calling...^M^J"
  2525.  
  2526.     FCLOSEO             ; CLose the file
  2527.     RETURN                ; Return from subroutine
  2528. ; -----------------------------------------------------------------------
  2529. ;    Auto baudrate detect (according to message in S9)
  2530. ;
  2531. ;    This procedure is placed last to ensure that the entire script
  2532. ;    file is scanned once before the main prompt.  COM-AND caches
  2533. ;    label addresses, so this ensures that the 1st 100 labels are
  2534. ;    known by COM-AND (and thus can be quickly reached).
  2535. ; -----------------------------------------------------------------------
  2536. ;
  2537. AutoBaud:
  2538.     IF FIND "_DDOVER" "ON" GOTO AUBA100
  2539.  
  2540.     IF FIND S9 "1200"
  2541.        SET BAUD 1200        ; Set to new rate
  2542.        GOTO AUBA100         ; Log the fact
  2543.        ENDIF
  2544.  
  2545.     IF FIND S9 "2400"
  2546.        SET BAUD 2400        ; Set to new rate
  2547.        GOTO AUBA100         ; Log the fact
  2548.        ENDIF
  2549.  
  2550.     IF FIND S9 "4800"
  2551.        SET BAUD 4800        ; Set to new rate
  2552.        GOTO AUBA100         ; Log the fact
  2553.        ENDIF
  2554.  
  2555.     IF FIND S9 "9600"
  2556.        SET BAUD 9600        ; Set to new rate
  2557.        GOTO AUBA100         ; Log the fact
  2558.        ENDIF
  2559.  
  2560.     IF FIND S9 "14400" or FIND S9 "14.4"
  2561.        SET BAUD 14k         ; Set to new rate
  2562.        GOTO AUBA100         ; Log the fact
  2563.        ENDIF
  2564.  
  2565.     IF FIND S9 "19200" or FIND S9 "19.2"
  2566.        SET BAUD 19k         ; Set to new rate
  2567.        GOTO AUBA100         ; Log the fact
  2568.        ENDIF
  2569.  
  2570.     IF FIND S9 "38400" or FIND S9 "38.4"
  2571.        SET BAUD 38k         ; Set to new rate
  2572.        GOTO AUBA100         ; Log the fact
  2573.        ENDIF
  2574.  
  2575.     IF FIND S9 "57600" or FIND S9 "57.6"
  2576.        SET BAUD 57k         ; Set to new rate
  2577.        GOTO AUBA100         ; Log the fact
  2578.        ENDIF
  2579. ;
  2580. ;    None of the above... set to 300
  2581. ;
  2582.     SET BAUD 300            ; Set to 1200 baud
  2583. ;
  2584. ;    Log the connect string to the log
  2585. ;
  2586. AUBA100:
  2587.     GOSUB Log_Item            ; Write connect string to log
  2588.     RETURN                ; We're done.
  2589.